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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1246  ! raeburn     4: # $Id: loncommon.pm,v 1.1245 2016/06/15 17:20:44 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.1182    raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    74: use DateTime::TimeZone;
1.1241    raeburn    75: use DateTime::Locale;
1.1220    raeburn    76: use Encode();
1.1091    foxr       77: use Text::Aspell;
1.1094    raeburn    78: use Authen::Captcha;
                     79: use Captcha::reCAPTCHA;
1.1234    raeburn    80: use JSON::DWIW;
                     81: use LWP::UserAgent;
1.1174    raeburn    82: use Crypt::DES;
                     83: use DynaLoader; # for Crypt::DES version
1.1223    musolffc   84: use MIME::Lite;
                     85: use MIME::Types;
1.117     www        86: 
1.517     raeburn    87: # ---------------------------------------------- Designs
                     88: use vars qw(%defaultdesign);
                     89: 
1.22      www        90: my $readit;
                     91: 
1.517     raeburn    92: 
1.157     matthew    93: ##
                     94: ## Global Variables
                     95: ##
1.46      matthew    96: 
1.643     foxr       97: 
                     98: # ----------------------------------------------- SSI with retries:
                     99: #
                    100: 
                    101: =pod
                    102: 
1.648     raeburn   103: =head1 Server Side include with retries:
1.643     foxr      104: 
                    105: =over 4
                    106: 
1.648     raeburn   107: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      108: 
                    109: Performs an ssi with some number of retries.  Retries continue either
                    110: until the result is ok or until the retry count supplied by the
                    111: caller is exhausted.  
                    112: 
                    113: Inputs:
1.648     raeburn   114: 
                    115: =over 4
                    116: 
1.643     foxr      117: resource   - Identifies the resource to insert.
1.648     raeburn   118: 
1.643     foxr      119: retries    - Count of the number of retries allowed.
1.648     raeburn   120: 
1.643     foxr      121: form       - Hash that identifies the rendering options.
                    122: 
1.648     raeburn   123: =back
                    124: 
                    125: Returns:
                    126: 
                    127: =over 4
                    128: 
1.643     foxr      129: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   130: 
1.643     foxr      131: response   - The response from the last attempt (which may or may not have been successful.
                    132: 
1.648     raeburn   133: =back
                    134: 
                    135: =back
                    136: 
1.643     foxr      137: =cut
                    138: 
                    139: sub ssi_with_retries {
                    140:     my ($resource, $retries, %form) = @_;
                    141: 
                    142: 
                    143:     my $ok = 0;			# True if we got a good response.
                    144:     my $content;
                    145:     my $response;
                    146: 
                    147:     # Try to get the ssi done. within the retries count:
                    148: 
                    149:     do {
                    150: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    151: 	$ok      = $response->is_success;
1.650     www       152:         if (!$ok) {
                    153:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    154:         }
1.643     foxr      155: 	$retries--;
                    156:     } while (!$ok && ($retries > 0));
                    157: 
                    158:     if (!$ok) {
                    159: 	$content = '';		# On error return an empty content.
                    160:     }
                    161:     return ($content, $response);
                    162: 
                    163: }
                    164: 
                    165: 
                    166: 
1.20      www       167: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  168: my %language;
1.124     www       169: my %supported_language;
1.1088    foxr      170: my %supported_codes;
1.1048    foxr      171: my %latex_language;		# For choosing hyphenation in <transl..>
                    172: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  173: my %cprtag;
1.192     taceyjo1  174: my %scprtag;
1.351     www       175: my %fe; my %fd; my %fm;
1.41      ng        176: my %category_extensions;
1.12      harris41  177: 
1.46      matthew   178: # ---------------------------------------------- Thesaurus variables
1.144     matthew   179: #
                    180: # %Keywords:
                    181: #      A hash used by &keyword to determine if a word is considered a keyword.
                    182: # $thesaurus_db_file 
                    183: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   184: 
                    185: my %Keywords;
                    186: my $thesaurus_db_file;
                    187: 
1.144     matthew   188: #
                    189: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    190: # thesaurus.tab, and filecategories.tab.
                    191: #
1.18      www       192: BEGIN {
1.46      matthew   193:     # Variable initialization
                    194:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    195:     #
1.22      www       196:     unless ($readit) {
1.12      harris41  197: # ------------------------------------------------------------------- languages
                    198:     {
1.158     raeburn   199:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    200:                                    '/language.tab';
                    201:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  202:             while (my $line = <$fh>) {
                    203:                 next if ($line=~/^\#/);
                    204:                 chomp($line);
1.1088    foxr      205:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   206:                 $language{$key}=$val.' - '.$enc;
                    207:                 if ($sup) {
                    208:                     $supported_language{$key}=$sup;
1.1088    foxr      209: 		    $supported_codes{$key}   = $code;
1.158     raeburn   210:                 }
1.1048    foxr      211: 		if ($latex) {
                    212: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      213: 		    $latex_language{$code} = $latex;
1.1048    foxr      214: 		}
1.158     raeburn   215:             }
                    216:             close($fh);
                    217:         }
1.12      harris41  218:     }
                    219: # ------------------------------------------------------------------ copyrights
                    220:     {
1.158     raeburn   221:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    222:                                   '/copyright.tab';
                    223:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  224:             while (my $line = <$fh>) {
                    225:                 next if ($line=~/^\#/);
                    226:                 chomp($line);
                    227:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   228:                 $cprtag{$key}=$val;
                    229:             }
                    230:             close($fh);
                    231:         }
1.12      harris41  232:     }
1.351     www       233: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  234:     {
                    235:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    236:                                   '/source_copyright.tab';
                    237:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  238:             while (my $line = <$fh>) {
                    239:                 next if ($line =~ /^\#/);
                    240:                 chomp($line);
                    241:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  242:                 $scprtag{$key}=$val;
                    243:             }
                    244:             close($fh);
                    245:         }
                    246:     }
1.63      www       247: 
1.517     raeburn   248: # -------------------------------------------------------------- default domain designs
1.63      www       249:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   250:     my $designfile = $designdir.'/default.tab';
                    251:     if ( open (my $fh,"<$designfile") ) {
                    252:         while (my $line = <$fh>) {
                    253:             next if ($line =~ /^\#/);
                    254:             chomp($line);
                    255:             my ($key,$val)=(split(/\=/,$line));
                    256:             if ($val) { $defaultdesign{$key}=$val; }
                    257:         }
                    258:         close($fh);
1.63      www       259:     }
                    260: 
1.15      harris41  261: # ------------------------------------------------------------- file categories
                    262:     {
1.158     raeburn   263:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    264:                                   '/filecategories.tab';
                    265:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  266: 	    while (my $line = <$fh>) {
                    267: 		next if ($line =~ /^\#/);
                    268: 		chomp($line);
                    269:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   270:                 push @{$category_extensions{lc($category)}},$extension;
                    271:             }
                    272:             close($fh);
                    273:         }
                    274: 
1.15      harris41  275:     }
1.12      harris41  276: # ------------------------------------------------------------------ file types
                    277:     {
1.158     raeburn   278:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    279:                '/filetypes.tab';
                    280:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  281:             while (my $line = <$fh>) {
                    282: 		next if ($line =~ /^\#/);
                    283: 		chomp($line);
                    284:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   285:                 if ($descr ne '') {
                    286:                     $fe{$ending}=lc($emb);
                    287:                     $fd{$ending}=$descr;
1.351     www       288:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   289:                 }
                    290:             }
                    291:             close($fh);
                    292:         }
1.12      harris41  293:     }
1.22      www       294:     &Apache::lonnet::logthis(
1.705     tempelho  295:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       296:     $readit=1;
1.46      matthew   297:     }  # end of unless($readit) 
1.32      matthew   298:     
                    299: }
1.112     bowersj2  300: 
1.42      matthew   301: ###############################################################
                    302: ##           HTML and Javascript Helper Functions            ##
                    303: ###############################################################
                    304: 
                    305: =pod 
                    306: 
1.112     bowersj2  307: =head1 HTML and Javascript Functions
1.42      matthew   308: 
1.112     bowersj2  309: =over 4
                    310: 
1.648     raeburn   311: =item * &browser_and_searcher_javascript()
1.112     bowersj2  312: 
                    313: X<browsing, javascript>X<searching, javascript>Returns a string
                    314: containing javascript with two functions, C<openbrowser> and
                    315: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    316: tags.
1.42      matthew   317: 
1.648     raeburn   318: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   319: 
                    320: inputs: formname, elementname, only, omit
                    321: 
                    322: formname and elementname indicate the name of the html form and name of
                    323: the element that the results of the browsing selection are to be placed in. 
                    324: 
                    325: Specifying 'only' will restrict the browser to displaying only files
1.185     www       326: with the given extension.  Can be a comma separated list.
1.42      matthew   327: 
                    328: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       329: with the given extension.  Can be a comma separated list.
1.42      matthew   330: 
1.648     raeburn   331: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   332: 
                    333: Inputs: formname, elementname
                    334: 
                    335: formname and elementname specify the name of the html form and the name
                    336: of the element the selection from the search results will be placed in.
1.542     raeburn   337: 
1.42      matthew   338: =cut
                    339: 
                    340: sub browser_and_searcher_javascript {
1.199     albertel  341:     my ($mode)=@_;
                    342:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  343:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   344:     return <<END;
1.219     albertel  345: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   346:     var editbrowser = null;
1.135     albertel  347:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       348:         var url = '$resurl/?';
1.42      matthew   349:         if (editbrowser == null) {
                    350:             url += 'launch=1&';
                    351:         }
                    352:         url += 'catalogmode=interactive&';
1.199     albertel  353:         url += 'mode=$mode&';
1.611     albertel  354:         url += 'inhibitmenu=yes&';
1.42      matthew   355:         url += 'form=' + formname + '&';
                    356:         if (only != null) {
                    357:             url += 'only=' + only + '&';
1.217     albertel  358:         } else {
                    359:             url += 'only=&';
                    360: 	}
1.42      matthew   361:         if (omit != null) {
                    362:             url += 'omit=' + omit + '&';
1.217     albertel  363:         } else {
                    364:             url += 'omit=&';
                    365: 	}
1.135     albertel  366:         if (titleelement != null) {
                    367:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  368:         } else {
                    369: 	    url += 'titleelement=&';
                    370: 	}
1.42      matthew   371:         url += 'element=' + elementname + '';
                    372:         var title = 'Browser';
1.435     albertel  373:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   374:         options += ',width=700,height=600';
                    375:         editbrowser = open(url,title,options,'1');
                    376:         editbrowser.focus();
                    377:     }
                    378:     var editsearcher;
1.135     albertel  379:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   380:         var url = '/adm/searchcat?';
                    381:         if (editsearcher == null) {
                    382:             url += 'launch=1&';
                    383:         }
                    384:         url += 'catalogmode=interactive&';
1.199     albertel  385:         url += 'mode=$mode&';
1.42      matthew   386:         url += 'form=' + formname + '&';
1.135     albertel  387:         if (titleelement != null) {
                    388:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  389:         } else {
                    390: 	    url += 'titleelement=&';
                    391: 	}
1.42      matthew   392:         url += 'element=' + elementname + '';
                    393:         var title = 'Search';
1.435     albertel  394:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   395:         options += ',width=700,height=600';
                    396:         editsearcher = open(url,title,options,'1');
                    397:         editsearcher.focus();
                    398:     }
1.219     albertel  399: // END LON-CAPA Internal -->
1.42      matthew   400: END
1.170     www       401: }
                    402: 
                    403: sub lastresurl {
1.258     albertel  404:     if ($env{'environment.lastresurl'}) {
                    405: 	return $env{'environment.lastresurl'}
1.170     www       406:     } else {
                    407: 	return '/res';
                    408:     }
                    409: }
                    410: 
                    411: sub storeresurl {
                    412:     my $resurl=&Apache::lonnet::clutter(shift);
                    413:     unless ($resurl=~/^\/res/) { return 0; }
                    414:     $resurl=~s/\/$//;
                    415:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   416:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       417:     return 1;
1.42      matthew   418: }
                    419: 
1.74      www       420: sub studentbrowser_javascript {
1.111     www       421:    unless (
1.258     albertel  422:             (($env{'request.course.id'}) && 
1.302     albertel  423:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    424: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    425: 					  '/'.$env{'request.course.sec'})
                    426: 	      ))
1.258     albertel  427:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       428:           ) { return ''; }  
1.74      www       429:    return (<<'ENDSTDBRW');
1.776     bisitz    430: <script type="text/javascript" language="Javascript">
1.824     bisitz    431: // <![CDATA[
1.74      www       432:     var stdeditbrowser;
1.999     www       433:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       434:         var url = '/adm/pickstudent?';
                    435:         var filter;
1.558     albertel  436: 	if (!ignorefilter) {
                    437: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    438: 	}
1.74      www       439:         if (filter != null) {
                    440:            if (filter != '') {
                    441:                url += 'filter='+filter+'&';
                    442: 	   }
                    443:         }
                    444:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       445:                                     '&udomelement='+udom+
                    446:                                     '&clicker='+clicker;
1.111     www       447: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   448:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       449:         var title = 'Student_Browser';
1.74      www       450:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    451:         options += ',width=700,height=600';
                    452:         stdeditbrowser = open(url,title,options,'1');
                    453:         stdeditbrowser.focus();
                    454:     }
1.824     bisitz    455: // ]]>
1.74      www       456: </script>
                    457: ENDSTDBRW
                    458: }
1.42      matthew   459: 
1.1003    www       460: sub resourcebrowser_javascript {
                    461:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       462:    return (<<'ENDRESBRW');
1.1003    www       463: <script type="text/javascript" language="Javascript">
                    464: // <![CDATA[
                    465:     var reseditbrowser;
1.1004    www       466:     function openresbrowser(formname,reslink) {
1.1005    www       467:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       468:         var title = 'Resource_Browser';
                    469:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       470:         options += ',width=700,height=500';
1.1004    www       471:         reseditbrowser = open(url,title,options,'1');
                    472:         reseditbrowser.focus();
1.1003    www       473:     }
                    474: // ]]>
                    475: </script>
1.1004    www       476: ENDRESBRW
1.1003    www       477: }
                    478: 
1.74      www       479: sub selectstudent_link {
1.999     www       480:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    481:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    482:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    483:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  484:    if ($env{'request.course.id'}) {  
1.302     albertel  485:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    486: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    487: 					'/'.$env{'request.course.sec'})) {
1.111     www       488: 	   return '';
                    489:        }
1.999     www       490:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   491:        if ($courseadvonly)  {
                    492:            $callargs .= ",'',1,1";
                    493:        }
                    494:        return '<span class="LC_nobreak">'.
                    495:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    496:               &mt('Select User').'</a></span>';
1.74      www       497:    }
1.258     albertel  498:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       499:        $callargs .= ",'',1"; 
1.793     raeburn   500:        return '<span class="LC_nobreak">'.
                    501:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    502:               &mt('Select User').'</a></span>';
1.111     www       503:    }
                    504:    return '';
1.91      www       505: }
                    506: 
1.1004    www       507: sub selectresource_link {
                    508:    my ($form,$reslink,$arg)=@_;
                    509:    
                    510:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    511:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    512:    unless ($env{'request.course.id'}) { return $arg; }
                    513:    return '<span class="LC_nobreak">'.
                    514:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    515:               $arg.'</a></span>';
                    516: }
                    517: 
                    518: 
                    519: 
1.653     raeburn   520: sub authorbrowser_javascript {
                    521:     return <<"ENDAUTHORBRW";
1.776     bisitz    522: <script type="text/javascript" language="JavaScript">
1.824     bisitz    523: // <![CDATA[
1.653     raeburn   524: var stdeditbrowser;
                    525: 
                    526: function openauthorbrowser(formname,udom) {
                    527:     var url = '/adm/pickauthor?';
                    528:     url += 'form='+formname+'&roledom='+udom;
                    529:     var title = 'Author_Browser';
                    530:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    531:     options += ',width=700,height=600';
                    532:     stdeditbrowser = open(url,title,options,'1');
                    533:     stdeditbrowser.focus();
                    534: }
                    535: 
1.824     bisitz    536: // ]]>
1.653     raeburn   537: </script>
                    538: ENDAUTHORBRW
                    539: }
                    540: 
1.91      www       541: sub coursebrowser_javascript {
1.1116    raeburn   542:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221    raeburn   543:         $credits_element,$instcode) = @_;
1.932     raeburn   544:     my $wintitle = 'Course_Browser';
1.931     raeburn   545:     if ($crstype eq 'Community') {
1.932     raeburn   546:         $wintitle = 'Community_Browser';
1.909     raeburn   547:     }
1.876     raeburn   548:     my $id_functions = &javascript_index_functions();
                    549:     my $output = '
1.776     bisitz    550: <script type="text/javascript" language="JavaScript">
1.824     bisitz    551: // <![CDATA[
1.468     raeburn   552:     var stdeditbrowser;'."\n";
1.876     raeburn   553: 
                    554:     $output .= <<"ENDSTDBRW";
1.909     raeburn   555:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       556:         var url = '/adm/pickcourse?';
1.895     raeburn   557:         var formid = getFormIdByName(formname);
1.876     raeburn   558:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  559:         if (domainfilter != null) {
                    560:            if (domainfilter != '') {
                    561:                url += 'domainfilter='+domainfilter+'&';
                    562: 	   }
                    563:         }
1.91      www       564:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  565: 	                            '&cdomelement='+udom+
                    566:                                     '&cnameelement='+desc;
1.468     raeburn   567:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   568:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   569:                 url += '&roleelement='+extra_element;
                    570:                 if (domainfilter == null || domainfilter == '') {
                    571:                     url += '&domainfilter='+extra_element;
                    572:                 }
1.234     raeburn   573:             }
1.468     raeburn   574:             else {
                    575:                 if (formname == 'portform') {
                    576:                     url += '&setroles='+extra_element;
1.800     raeburn   577:                 } else {
                    578:                     if (formname == 'rules') {
                    579:                         url += '&fixeddom='+extra_element; 
                    580:                     }
1.468     raeburn   581:                 }
                    582:             }     
1.230     raeburn   583:         }
1.909     raeburn   584:         if (type != null && type != '') {
                    585:             url += '&type='+type;
                    586:         }
                    587:         if (type_elem != null && type_elem != '') {
                    588:             url += '&typeelement='+type_elem;
                    589:         }
1.872     raeburn   590:         if (formname == 'ccrs') {
                    591:             var ownername = document.forms[formid].ccuname.value;
                    592:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238    raeburn   593:             url += '&cloner='+ownername+':'+ownerdom;
                    594:             if (type == 'Course') {
                    595:                 url += '&crscode='+document.forms[formid].crscode.value;
                    596:             }
1.1221    raeburn   597:         }
                    598:         if (formname == 'requestcrs') {
                    599:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   600:         }
1.293     raeburn   601:         if (multflag !=null && multflag != '') {
                    602:             url += '&multiple='+multflag;
                    603:         }
1.909     raeburn   604:         var title = '$wintitle';
1.91      www       605:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    606:         options += ',width=700,height=600';
                    607:         stdeditbrowser = open(url,title,options,'1');
                    608:         stdeditbrowser.focus();
                    609:     }
1.876     raeburn   610: $id_functions
                    611: ENDSTDBRW
1.1116    raeburn   612:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    613:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    614:                                       $credits_element);
1.876     raeburn   615:     }
                    616:     $output .= '
                    617: // ]]>
                    618: </script>';
                    619:     return $output;
                    620: }
                    621: 
                    622: sub javascript_index_functions {
                    623:     return <<"ENDJS";
                    624: 
                    625: function getFormIdByName(formname) {
                    626:     for (var i=0;i<document.forms.length;i++) {
                    627:         if (document.forms[i].name == formname) {
                    628:             return i;
                    629:         }
                    630:     }
                    631:     return -1;
                    632: }
                    633: 
                    634: function getIndexByName(formid,item) {
                    635:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    636:         if (document.forms[formid].elements[i].name == item) {
                    637:             return i;
                    638:         }
                    639:     }
                    640:     return -1;
                    641: }
1.468     raeburn   642: 
1.876     raeburn   643: function getDomainFromSelectbox(formname,udom) {
                    644:     var userdom;
                    645:     var formid = getFormIdByName(formname);
                    646:     if (formid > -1) {
                    647:         var domid = getIndexByName(formid,udom);
                    648:         if (domid > -1) {
                    649:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    650:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    651:             }
                    652:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    653:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   654:             }
                    655:         }
                    656:     }
1.876     raeburn   657:     return userdom;
                    658: }
                    659: 
                    660: ENDJS
1.468     raeburn   661: 
1.876     raeburn   662: }
                    663: 
1.1017    raeburn   664: sub javascript_array_indexof {
1.1018    raeburn   665:     return <<ENDJS;
1.1017    raeburn   666: <script type="text/javascript" language="JavaScript">
                    667: // <![CDATA[
                    668: 
                    669: if (!Array.prototype.indexOf) {
                    670:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    671:         "use strict";
                    672:         if (this === void 0 || this === null) {
                    673:             throw new TypeError();
                    674:         }
                    675:         var t = Object(this);
                    676:         var len = t.length >>> 0;
                    677:         if (len === 0) {
                    678:             return -1;
                    679:         }
                    680:         var n = 0;
                    681:         if (arguments.length > 0) {
                    682:             n = Number(arguments[1]);
1.1088    foxr      683:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   684:                 n = 0;
                    685:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    686:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    687:             }
                    688:         }
                    689:         if (n >= len) {
                    690:             return -1;
                    691:         }
                    692:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    693:         for (; k < len; k++) {
                    694:             if (k in t && t[k] === searchElement) {
                    695:                 return k;
                    696:             }
                    697:         }
                    698:         return -1;
                    699:     }
                    700: }
                    701: 
                    702: // ]]>
                    703: </script>
                    704: 
                    705: ENDJS
                    706: 
                    707: }
                    708: 
1.876     raeburn   709: sub userbrowser_javascript {
                    710:     my $id_functions = &javascript_index_functions();
                    711:     return <<"ENDUSERBRW";
                    712: 
1.888     raeburn   713: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   714:     var url = '/adm/pickuser?';
                    715:     var userdom = getDomainFromSelectbox(formname,udom);
                    716:     if (userdom != null) {
                    717:        if (userdom != '') {
                    718:            url += 'srchdom='+userdom+'&';
                    719:        }
                    720:     }
                    721:     url += 'form=' + formname + '&unameelement='+uname+
                    722:                                 '&udomelement='+udom+
                    723:                                 '&ulastelement='+ulast+
                    724:                                 '&ufirstelement='+ufirst+
                    725:                                 '&uemailelement='+uemail+
1.881     raeburn   726:                                 '&hideudomelement='+hideudom+
                    727:                                 '&coursedom='+crsdom;
1.888     raeburn   728:     if ((caller != null) && (caller != undefined)) {
                    729:         url += '&caller='+caller;
                    730:     }
1.876     raeburn   731:     var title = 'User_Browser';
                    732:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    733:     options += ',width=700,height=600';
                    734:     var stdeditbrowser = open(url,title,options,'1');
                    735:     stdeditbrowser.focus();
                    736: }
                    737: 
1.888     raeburn   738: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   739:     var formid = getFormIdByName(formname);
                    740:     if (formid > -1) {
1.888     raeburn   741:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   742:         var domid = getIndexByName(formid,udom);
                    743:         var hidedomid = getIndexByName(formid,origdom);
                    744:         if (hidedomid > -1) {
                    745:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   746:             var unameval = document.forms[formid].elements[unameid].value;
                    747:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    748:                 if (domid > -1) {
                    749:                     var slct = document.forms[formid].elements[domid];
                    750:                     if (slct.type == 'select-one') {
                    751:                         var i;
                    752:                         for (i=0;i<slct.length;i++) {
                    753:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    754:                         }
                    755:                     }
                    756:                     if (slct.type == 'hidden') {
                    757:                         slct.value = fixeddom;
1.876     raeburn   758:                     }
                    759:                 }
1.468     raeburn   760:             }
                    761:         }
                    762:     }
1.876     raeburn   763:     return;
                    764: }
                    765: 
                    766: $id_functions
                    767: ENDUSERBRW
1.468     raeburn   768: }
                    769: 
                    770: sub setsec_javascript {
1.1116    raeburn   771:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   772:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    773:         $communityrolestr);
                    774:     if ($role_element ne '') {
                    775:         my @allroles = ('st','ta','ep','in','ad');
                    776:         foreach my $crstype ('Course','Community') {
                    777:             if ($crstype eq 'Community') {
                    778:                 foreach my $role (@allroles) {
                    779:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    780:                 }
                    781:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    782:             } else {
                    783:                 foreach my $role (@allroles) {
                    784:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    785:                 }
                    786:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    787:             }
                    788:         }
                    789:         $rolestr = '"'.join('","',@allroles).'"';
                    790:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    791:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    792:     }
1.468     raeburn   793:     my $setsections = qq|
                    794: function setSect(sectionlist) {
1.629     raeburn   795:     var sectionsArray = new Array();
                    796:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    797:         sectionsArray = sectionlist.split(",");
                    798:     }
1.468     raeburn   799:     var numSections = sectionsArray.length;
                    800:     document.$formname.$sec_element.length = 0;
                    801:     if (numSections == 0) {
                    802:         document.$formname.$sec_element.multiple=false;
                    803:         document.$formname.$sec_element.size=1;
                    804:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    805:     } else {
                    806:         if (numSections == 1) {
                    807:             document.$formname.$sec_element.multiple=false;
                    808:             document.$formname.$sec_element.size=1;
                    809:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    810:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    811:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    812:         } else {
                    813:             for (var i=0; i<numSections; i++) {
                    814:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    815:             }
                    816:             document.$formname.$sec_element.multiple=true
                    817:             if (numSections < 3) {
                    818:                 document.$formname.$sec_element.size=numSections;
                    819:             } else {
                    820:                 document.$formname.$sec_element.size=3;
                    821:             }
                    822:             document.$formname.$sec_element.options[0].selected = false
                    823:         }
                    824:     }
1.91      www       825: }
1.905     raeburn   826: 
                    827: function setRole(crstype) {
1.468     raeburn   828: |;
1.905     raeburn   829:     if ($role_element eq '') {
                    830:         $setsections .= '    return;
                    831: }
                    832: ';
                    833:     } else {
                    834:         $setsections .= qq|
                    835:     var elementLength = document.$formname.$role_element.length;
                    836:     var allroles = Array($rolestr);
                    837:     var courserolenames = Array($courserolestr);
                    838:     var communityrolenames = Array($communityrolestr);
                    839:     if (elementLength != undefined) {
                    840:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    841:             if (crstype == 'Course') {
                    842:                 return;
                    843:             } else {
                    844:                 allroles[5] = 'co';
                    845:                 for (var i=0; i<6; i++) {
                    846:                     document.$formname.$role_element.options[i].value = allroles[i];
                    847:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    848:                 }
                    849:             }
                    850:         } else {
                    851:             if (crstype == 'Community') {
                    852:                 return;
                    853:             } else {
                    854:                 allroles[5] = 'cc';
                    855:                 for (var i=0; i<6; i++) {
                    856:                     document.$formname.$role_element.options[i].value = allroles[i];
                    857:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    858:                 }
                    859:             }
                    860:         }
                    861:     }
                    862:     return;
                    863: }
                    864: |;
                    865:     }
1.1116    raeburn   866:     if ($credits_element) {
                    867:         $setsections .= qq|
                    868: function setCredits(defaultcredits) {
                    869:     document.$formname.$credits_element.value = defaultcredits;
                    870:     return;
                    871: }
                    872: |;
                    873:     }
1.468     raeburn   874:     return $setsections;
                    875: }
                    876: 
1.91      www       877: sub selectcourse_link {
1.909     raeburn   878:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    879:        $typeelement) = @_;
                    880:    my $type = $selecttype;
1.871     raeburn   881:    my $linktext = &mt('Select Course');
                    882:    if ($selecttype eq 'Community') {
1.909     raeburn   883:        $linktext = &mt('Select Community');
1.1239    raeburn   884:    } elsif ($selecttype eq 'Placement') {
                    885:        $linktext = &mt('Select Placement Test'); 
1.906     raeburn   886:    } elsif ($selecttype eq 'Course/Community') {
                    887:        $linktext = &mt('Select Course/Community');
1.909     raeburn   888:        $type = '';
1.1019    raeburn   889:    } elsif ($selecttype eq 'Select') {
                    890:        $linktext = &mt('Select');
                    891:        $type = '';
1.871     raeburn   892:    }
1.787     bisitz    893:    return '<span class="LC_nobreak">'
                    894:          ."<a href='"
                    895:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    896:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   897:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   898:          ."'>".$linktext.'</a>'
1.787     bisitz    899:          .'</span>';
1.74      www       900: }
1.42      matthew   901: 
1.653     raeburn   902: sub selectauthor_link {
                    903:    my ($form,$udom)=@_;
                    904:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    905:           &mt('Select Author').'</a>';
                    906: }
                    907: 
1.876     raeburn   908: sub selectuser_link {
1.881     raeburn   909:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   910:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   911:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   912:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   913:            ');">'.$linktext.'</a>';
1.876     raeburn   914: }
                    915: 
1.273     raeburn   916: sub check_uncheck_jscript {
                    917:     my $jscript = <<"ENDSCRT";
                    918: function checkAll(field) {
                    919:     if (field.length > 0) {
                    920:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   921:             if (!field[i].disabled) { 
                    922:                 field[i].checked = true;
                    923:             }
1.273     raeburn   924:         }
                    925:     } else {
1.1093    raeburn   926:         if (!field.disabled) { 
                    927:             field.checked = true;
                    928:         }
1.273     raeburn   929:     }
                    930: }
                    931:  
                    932: function uncheckAll(field) {
                    933:     if (field.length > 0) {
                    934:         for (i = 0; i < field.length; i++) {
                    935:             field[i].checked = false ;
1.543     albertel  936:         }
                    937:     } else {
1.273     raeburn   938:         field.checked = false ;
                    939:     }
                    940: }
                    941: ENDSCRT
                    942:     return $jscript;
                    943: }
                    944: 
1.656     www       945: sub select_timezone {
1.659     raeburn   946:    my ($name,$selected,$onchange,$includeempty)=@_;
                    947:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    948:    if ($includeempty) {
                    949:        $output .= '<option value=""';
                    950:        if (($selected eq '') || ($selected eq 'local')) {
                    951:            $output .= ' selected="selected" ';
                    952:        }
                    953:        $output .= '> </option>';
                    954:    }
1.657     raeburn   955:    my @timezones = DateTime::TimeZone->all_names;
                    956:    foreach my $tzone (@timezones) {
                    957:        $output.= '<option value="'.$tzone.'"';
                    958:        if ($tzone eq $selected) {
                    959:            $output.=' selected="selected"';
                    960:        }
                    961:        $output.=">$tzone</option>\n";
1.656     www       962:    }
                    963:    $output.="</select>";
                    964:    return $output;
                    965: }
1.273     raeburn   966: 
1.687     raeburn   967: sub select_datelocale {
                    968:     my ($name,$selected,$onchange,$includeempty)=@_;
                    969:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    970:     if ($includeempty) {
                    971:         $output .= '<option value=""';
                    972:         if ($selected eq '') {
                    973:             $output .= ' selected="selected" ';
                    974:         }
                    975:         $output .= '> </option>';
                    976:     }
1.1241    raeburn   977:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   978:     my (@possibles,%locale_names);
1.1241    raeburn   979:     my @locales = DateTime::Locale->ids();
                    980:     foreach my $id (@locales) {
                    981:         if ($id ne '') {
                    982:             my ($en_terr,$native_terr);
                    983:             my $loc = DateTime::Locale->load($id);
                    984:             if (ref($loc)) {
                    985:                 $en_terr = $loc->name();
                    986:                 $native_terr = $loc->native_name();
1.687     raeburn   987:                 if (grep(/^en$/,@languages) || !@languages) {
                    988:                     if ($en_terr ne '') {
                    989:                         $locale_names{$id} = '('.$en_terr.')';
                    990:                     } elsif ($native_terr ne '') {
                    991:                         $locale_names{$id} = $native_terr;
                    992:                     }
                    993:                 } else {
                    994:                     if ($native_terr ne '') {
                    995:                         $locale_names{$id} = $native_terr.' ';
                    996:                     } elsif ($en_terr ne '') {
                    997:                         $locale_names{$id} = '('.$en_terr.')';
                    998:                     }
                    999:                 }
1.1220    raeburn  1000:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241    raeburn  1001:                 push(@possibles,$id);
                   1002:             } 
1.687     raeburn  1003:         }
                   1004:     }
                   1005:     foreach my $item (sort(@possibles)) {
                   1006:         $output.= '<option value="'.$item.'"';
                   1007:         if ($item eq $selected) {
                   1008:             $output.=' selected="selected"';
                   1009:         }
                   1010:         $output.=">$item";
                   1011:         if ($locale_names{$item} ne '') {
1.1220    raeburn  1012:             $output.='  '.$locale_names{$item};
1.687     raeburn  1013:         }
                   1014:         $output.="</option>\n";
                   1015:     }
                   1016:     $output.="</select>";
                   1017:     return $output;
                   1018: }
                   1019: 
1.792     raeburn  1020: sub select_language {
                   1021:     my ($name,$selected,$includeempty) = @_;
                   1022:     my %langchoices;
                   1023:     if ($includeempty) {
1.1117    raeburn  1024:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1025:     }
                   1026:     foreach my $id (&languageids()) {
                   1027:         my $code = &supportedlanguagecode($id);
                   1028:         if ($code) {
                   1029:             $langchoices{$code} = &plainlanguagedescription($id);
                   1030:         }
                   1031:     }
1.1117    raeburn  1032:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1033:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1034: }
                   1035: 
1.42      matthew  1036: =pod
1.36      matthew  1037: 
1.1088    foxr     1038: 
                   1039: =item * &list_languages()
                   1040: 
                   1041: Returns an array reference that is suitable for use in language prompters.
                   1042: Each array element is itself a two element array.  The first element
                   1043: is the language code.  The second element a descsriptiuon of the 
                   1044: language itself.  This is suitable for use in e.g.
                   1045: &Apache::edit::select_arg (once dereferenced that is).
                   1046: 
                   1047: =cut 
                   1048: 
                   1049: sub list_languages {
                   1050:     my @lang_choices;
                   1051: 
                   1052:     foreach my $id (&languageids()) {
                   1053: 	my $code = &supportedlanguagecode($id);
                   1054: 	if ($code) {
                   1055: 	    my $selector    = $supported_codes{$id};
                   1056: 	    my $description = &plainlanguagedescription($id);
                   1057: 	    push (@lang_choices, [$selector, $description]);
                   1058: 	}
                   1059:     }
                   1060:     return \@lang_choices;
                   1061: }
                   1062: 
                   1063: =pod
                   1064: 
1.648     raeburn  1065: =item * &linked_select_forms(...)
1.36      matthew  1066: 
                   1067: linked_select_forms returns a string containing a <script></script> block
                   1068: and html for two <select> menus.  The select menus will be linked in that
                   1069: changing the value of the first menu will result in new values being placed
                   1070: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1071: order unless a defined order is provided.
1.36      matthew  1072: 
                   1073: linked_select_forms takes the following ordered inputs:
                   1074: 
                   1075: =over 4
                   1076: 
1.112     bowersj2 1077: =item * $formname, the name of the <form> tag
1.36      matthew  1078: 
1.112     bowersj2 1079: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1080: 
1.112     bowersj2 1081: =item * $firstdefault, the default value for the first menu
1.36      matthew  1082: 
1.112     bowersj2 1083: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1084: 
1.112     bowersj2 1085: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1086: 
1.112     bowersj2 1087: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1088: 
1.609     raeburn  1089: =item * $menuorder, the order of values in the first menu
                   1090: 
1.1115    raeburn  1091: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1092:         event for the first <select> tag
                   1093: 
                   1094: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1095:         event for the second <select> tag
                   1096: 
1.1245    raeburn  1097: =item * $suffix, to differentiate separate uses of select2data javascript
                   1098:         objects in a page.
                   1099: 
1.41      ng       1100: =back 
                   1101: 
1.36      matthew  1102: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1103: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1104: values for the first select menu.  The text that coincides with the 
1.41      ng       1105: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1106: and text for the second menu are given in the hash pointed to by 
                   1107: $menu{$choice1}->{'select2'}.  
                   1108: 
1.112     bowersj2 1109:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1110:                        default => "B3",
                   1111:                        select2 => { 
                   1112:                            B1 => "Choice B1",
                   1113:                            B2 => "Choice B2",
                   1114:                            B3 => "Choice B3",
                   1115:                            B4 => "Choice B4"
1.609     raeburn  1116:                            },
                   1117:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1118:                    },
                   1119:                A2 => { text =>"Choice A2" ,
                   1120:                        default => "C2",
                   1121:                        select2 => { 
                   1122:                            C1 => "Choice C1",
                   1123:                            C2 => "Choice C2",
                   1124:                            C3 => "Choice C3"
1.609     raeburn  1125:                            },
                   1126:                        order => ['C2','C1','C3'],
1.112     bowersj2 1127:                    },
                   1128:                A3 => { text =>"Choice A3" ,
                   1129:                        default => "D6",
                   1130:                        select2 => { 
                   1131:                            D1 => "Choice D1",
                   1132:                            D2 => "Choice D2",
                   1133:                            D3 => "Choice D3",
                   1134:                            D4 => "Choice D4",
                   1135:                            D5 => "Choice D5",
                   1136:                            D6 => "Choice D6",
                   1137:                            D7 => "Choice D7"
1.609     raeburn  1138:                            },
                   1139:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1140:                    }
                   1141:                );
1.36      matthew  1142: 
                   1143: =cut
                   1144: 
                   1145: sub linked_select_forms {
                   1146:     my ($formname,
                   1147:         $middletext,
                   1148:         $firstdefault,
                   1149:         $firstselectname,
                   1150:         $secondselectname, 
1.609     raeburn  1151:         $hashref,
                   1152:         $menuorder,
1.1115    raeburn  1153:         $onchangefirst,
1.1245    raeburn  1154:         $onchangesecond,
                   1155:         $suffix
1.36      matthew  1156:         ) = @_;
                   1157:     my $second = "document.$formname.$secondselectname";
                   1158:     my $first = "document.$formname.$firstselectname";
                   1159:     # output the javascript to do the changing
                   1160:     my $result = '';
1.776     bisitz   1161:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1162:     $result.="// <![CDATA[\n";
1.1245    raeburn  1163:     $result.="var select2data${suffix} = new Object();\n";
1.36      matthew  1164:     $" = '","';
                   1165:     my $debug = '';
                   1166:     foreach my $s1 (sort(keys(%$hashref))) {
1.1245    raeburn  1167:         $result.="select2data${suffix}['d_$s1'] = new Object();\n";        
                   1168:         $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36      matthew  1169:             $hashref->{$s1}->{'default'}."');\n";
1.1245    raeburn  1170:         $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36      matthew  1171:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1172:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1173:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1174:         }
1.36      matthew  1175:         $result.="\"@s2values\");\n";
1.1245    raeburn  1176:         $result.="select2data${suffix}['d_$s1'].texts = new Array(";        
1.36      matthew  1177:         my @s2texts;
                   1178:         foreach my $value (@s2values) {
                   1179:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1180:         }
                   1181:         $result.="\"@s2texts\");\n";
                   1182:     }
                   1183:     $"=' ';
                   1184:     $result.= <<"END";
                   1185: 
1.1245    raeburn  1186: function select1${suffix}_changed() {
1.36      matthew  1187:     // Determine new choice
1.1245    raeburn  1188:     var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36      matthew  1189:     // update select2
1.1245    raeburn  1190:     var values     = select2data${suffix}[newvalue].values;
                   1191:     var texts      = select2data${suffix}[newvalue].texts;
                   1192:     var select2def = select2data${suffix}[newvalue].def;
1.36      matthew  1193:     var i;
                   1194:     // out with the old
1.1245    raeburn  1195:     $second.options.length = 0;
                   1196:     // in with the new
1.36      matthew  1197:     for (i=0;i<values.length; i++) {
                   1198:         $second.options[i] = new Option(values[i]);
1.143     matthew  1199:         $second.options[i].value = values[i];
1.36      matthew  1200:         $second.options[i].text = texts[i];
                   1201:         if (values[i] == select2def) {
                   1202:             $second.options[i].selected = true;
                   1203:         }
                   1204:     }
                   1205: }
1.824     bisitz   1206: // ]]>
1.36      matthew  1207: </script>
                   1208: END
                   1209:     # output the initial values for the selection lists
1.1245    raeburn  1210:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609     raeburn  1211:     my @order = sort(keys(%{$hashref}));
                   1212:     if (ref($menuorder) eq 'ARRAY') {
                   1213:         @order = @{$menuorder};
                   1214:     }
                   1215:     foreach my $value (@order) {
1.36      matthew  1216:         $result.="    <option value=\"$value\" ";
1.253     albertel 1217:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1218:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1219:     }
                   1220:     $result .= "</select>\n";
                   1221:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1222:     $result .= $middletext;
1.1115    raeburn  1223:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1224:     if ($onchangesecond) {
                   1225:         $result .= ' onchange="'.$onchangesecond.'"';
                   1226:     }
                   1227:     $result .= ">\n";
1.36      matthew  1228:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1229:     
                   1230:     my @secondorder = sort(keys(%select2));
                   1231:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1232:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1233:     }
                   1234:     foreach my $value (@secondorder) {
1.36      matthew  1235:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1236:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1237:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1238:     }
                   1239:     $result .= "</select>\n";
                   1240:     #    return $debug;
                   1241:     return $result;
                   1242: }   #  end of sub linked_select_forms {
                   1243: 
1.45      matthew  1244: =pod
1.44      bowersj2 1245: 
1.973     raeburn  1246: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1247: 
1.112     bowersj2 1248: Returns a string corresponding to an HTML link to the given help
                   1249: $topic, where $topic corresponds to the name of a .tex file in
                   1250: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1251: spaces. 
                   1252: 
                   1253: $text will optionally be linked to the same topic, allowing you to
                   1254: link text in addition to the graphic. If you do not want to link
                   1255: text, but wish to specify one of the later parameters, pass an
                   1256: empty string. 
                   1257: 
                   1258: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1259: the link will not open a new window. If false, the link will open
                   1260: a new window using Javascript. (Default is false.) 
                   1261: 
                   1262: $width and $height are optional numerical parameters that will
                   1263: override the width and height of the popped up window, which may
1.973     raeburn  1264: be useful for certain help topics with big pictures included.
                   1265: 
                   1266: $imgid is the id of the img tag used for the help icon. This may be
                   1267: used in a javascript call to switch the image src.  See 
                   1268: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1269: 
                   1270: =cut
                   1271: 
                   1272: sub help_open_topic {
1.973     raeburn  1273:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1274:     $text = "" if (not defined $text);
1.44      bowersj2 1275:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1276:     $width = 500 if (not defined $width);
1.44      bowersj2 1277:     $height = 400 if (not defined $height);
                   1278:     my $filename = $topic;
                   1279:     $filename =~ s/ /_/g;
                   1280: 
1.48      bowersj2 1281:     my $template = "";
                   1282:     my $link;
1.572     banghart 1283:     
1.159     www      1284:     $topic=~s/\W/\_/g;
1.44      bowersj2 1285: 
1.572     banghart 1286:     if (!$stayOnPage) {
1.1033    www      1287: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1288:     } elsif ($stayOnPage eq 'popup') {
                   1289:         $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 1290:     } else {
1.48      bowersj2 1291: 	$link = "/adm/help/${filename}.hlp";
                   1292:     }
                   1293: 
                   1294:     # Add the text
1.755     neumanie 1295:     if ($text ne "") {	
1.763     bisitz   1296: 	$template.='<span class="LC_help_open_topic">'
                   1297:                   .'<a target="_top" href="'.$link.'">'
                   1298:                   .$text.'</a>';
1.48      bowersj2 1299:     }
                   1300: 
1.763     bisitz   1301:     # (Always) Add the graphic
1.179     matthew  1302:     my $title = &mt('Online Help');
1.667     raeburn  1303:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1304:     if ($imgid ne '') {
                   1305:         $imgid = ' id="'.$imgid.'"';
                   1306:     }
1.763     bisitz   1307:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1308:               .'<img src="'.$helpicon.'" border="0"'
                   1309:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1310:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1311:               .' /></a>';
                   1312:     if ($text ne "") {	
                   1313:         $template.='</span>';
                   1314:     }
1.44      bowersj2 1315:     return $template;
                   1316: 
1.106     bowersj2 1317: }
                   1318: 
                   1319: # This is a quicky function for Latex cheatsheet editing, since it 
                   1320: # appears in at least four places
                   1321: sub helpLatexCheatsheet {
1.1037    www      1322:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1323:     my $out;
1.106     bowersj2 1324:     my $addOther = '';
1.732     raeburn  1325:     if ($topic) {
1.1037    www      1326: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1327:     }
                   1328:     $out = '<span>' # Start cheatsheet
                   1329: 	  .$addOther
                   1330:           .'<span>'
1.1037    www      1331: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1332: 	  .'</span> <span>'
1.1037    www      1333: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1334: 	  .'</span>';
1.732     raeburn  1335:     unless ($not_author) {
1.1186    kruse    1336:         $out .= '<span>'
                   1337:                .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                   1338:                .'</span> <span>'
                   1339:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763     bisitz   1340: 	       .'</span>';
1.732     raeburn  1341:     }
1.763     bisitz   1342:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1343:     return $out;
1.172     www      1344: }
                   1345: 
1.430     albertel 1346: sub general_help {
                   1347:     my $helptopic='Student_Intro';
                   1348:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1349: 	$helptopic='Authoring_Intro';
1.907     raeburn  1350:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1351: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1352:     } elsif ($env{'request.role'}=~/^dc/) {
                   1353:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1354:     }
                   1355:     return $helptopic;
                   1356: }
                   1357: 
                   1358: sub update_help_link {
                   1359:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1360:     my $origurl = $ENV{'REQUEST_URI'};
                   1361:     $origurl=~s|^/~|/priv/|;
                   1362:     my $timestamp = time;
                   1363:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1364:         $$datum = &escape($$datum);
                   1365:     }
                   1366: 
                   1367:     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";
                   1368:     my $output .= <<"ENDOUTPUT";
                   1369: <script type="text/javascript">
1.824     bisitz   1370: // <![CDATA[
1.430     albertel 1371: banner_link = '$banner_link';
1.824     bisitz   1372: // ]]>
1.430     albertel 1373: </script>
                   1374: ENDOUTPUT
                   1375:     return $output;
                   1376: }
                   1377: 
                   1378: # now just updates the help link and generates a blue icon
1.193     raeburn  1379: sub help_open_menu {
1.430     albertel 1380:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1381: 	= @_;    
1.949     droeschl 1382:     $stayOnPage = 1;
1.430     albertel 1383:     my $output;
                   1384:     if ($component_help) {
                   1385: 	if (!$text) {
                   1386: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1387: 				       $width,$height);
                   1388: 	} else {
                   1389: 	    my $help_text;
                   1390: 	    $help_text=&unescape($topic);
                   1391: 	    $output='<table><tr><td>'.
                   1392: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1393: 				 $width,$height).'</td></tr></table>';
                   1394: 	}
                   1395:     }
                   1396:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1397:     return $output.$banner_link;
                   1398: }
                   1399: 
                   1400: sub top_nav_help {
                   1401:     my ($text) = @_;
1.436     albertel 1402:     $text = &mt($text);
1.949     droeschl 1403:     my $stay_on_page = 1;
                   1404: 
1.1168    raeburn  1405:     my ($link,$banner_link);
                   1406:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1407:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1408: 	                         : "javascript:helpMenu('open')";
                   1409:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1410:     }
1.201     raeburn  1411:     my $title = &mt('Get help');
1.1168    raeburn  1412:     if ($link) {
                   1413:         return <<"END";
1.436     albertel 1414: $banner_link
1.1159    raeburn  1415: <a href="$link" title="$title">$text</a>
1.436     albertel 1416: END
1.1168    raeburn  1417:     } else {
                   1418:         return '&nbsp;'.$text.'&nbsp;';
                   1419:     }
1.436     albertel 1420: }
                   1421: 
                   1422: sub help_menu_js {
1.1154    raeburn  1423:     my ($httphost) = @_;
1.949     droeschl 1424:     my $stayOnPage = 1;
1.436     albertel 1425:     my $width = 620;
                   1426:     my $height = 600;
1.430     albertel 1427:     my $helptopic=&general_help();
1.1154    raeburn  1428:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1429:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1430:     my $start_page =
                   1431:         &Apache::loncommon::start_page('Help Menu', undef,
                   1432: 				       {'frameset'    => 1,
                   1433: 					'js_ready'    => 1,
1.1154    raeburn  1434:                                         'use_absolute' => $httphost,
1.331     albertel 1435: 					'add_entries' => {
1.1168    raeburn  1436: 					    'border' => '0', 
1.579     raeburn  1437: 					    'rows'   => "110,*",},});
1.331     albertel 1438:     my $end_page =
                   1439:         &Apache::loncommon::end_page({'frameset' => 1,
                   1440: 				      'js_ready' => 1,});
                   1441: 
1.436     albertel 1442:     my $template .= <<"ENDTEMPLATE";
                   1443: <script type="text/javascript">
1.877     bisitz   1444: // <![CDATA[
1.253     albertel 1445: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1446: var banner_link = '';
1.243     raeburn  1447: function helpMenu(target) {
                   1448:     var caller = this;
                   1449:     if (target == 'open') {
                   1450:         var newWindow = null;
                   1451:         try {
1.262     albertel 1452:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1453:         }
                   1454:         catch(error) {
                   1455:             writeHelp(caller);
                   1456:             return;
                   1457:         }
                   1458:         if (newWindow) {
                   1459:             caller = newWindow;
                   1460:         }
1.193     raeburn  1461:     }
1.243     raeburn  1462:     writeHelp(caller);
                   1463:     return;
                   1464: }
                   1465: function writeHelp(caller) {
1.1168    raeburn  1466:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1467:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1468:     caller.document.close();
                   1469:     caller.focus();
1.193     raeburn  1470: }
1.877     bisitz   1471: // END LON-CAPA Internal -->
1.253     albertel 1472: // ]]>
1.436     albertel 1473: </script>
1.193     raeburn  1474: ENDTEMPLATE
                   1475:     return $template;
                   1476: }
                   1477: 
1.172     www      1478: sub help_open_bug {
                   1479:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1480:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1481:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1482:     $text = "" if (not defined $text);
                   1483: 	$stayOnPage=1;
1.184     albertel 1484:     $width = 600 if (not defined $width);
                   1485:     $height = 600 if (not defined $height);
1.172     www      1486: 
                   1487:     $topic=~s/\W+/\+/g;
                   1488:     my $link='';
                   1489:     my $template='';
1.379     albertel 1490:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1491: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1492:     if (!$stayOnPage)
                   1493:     {
                   1494: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1495:     }
                   1496:     else
                   1497:     {
                   1498: 	$link = $url;
                   1499:     }
                   1500:     # Add the text
                   1501:     if ($text ne "")
                   1502:     {
                   1503: 	$template .= 
                   1504:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1505:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1506:     }
                   1507: 
                   1508:     # Add the graphic
1.179     matthew  1509:     my $title = &mt('Report a Bug');
1.215     albertel 1510:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1511:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1512:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1513: ENDTEMPLATE
                   1514:     if ($text ne '') { $template.='</td></tr></table>' };
                   1515:     return $template;
                   1516: 
                   1517: }
                   1518: 
                   1519: sub help_open_faq {
                   1520:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1521:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1522:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1523:     $text = "" if (not defined $text);
                   1524: 	$stayOnPage=1;
                   1525:     $width = 350 if (not defined $width);
                   1526:     $height = 400 if (not defined $height);
                   1527: 
                   1528:     $topic=~s/\W+/\+/g;
                   1529:     my $link='';
                   1530:     my $template='';
                   1531:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1532:     if (!$stayOnPage)
                   1533:     {
                   1534: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1535:     }
                   1536:     else
                   1537:     {
                   1538: 	$link = $url;
                   1539:     }
                   1540: 
                   1541:     # Add the text
                   1542:     if ($text ne "")
                   1543:     {
                   1544: 	$template .= 
1.173     www      1545:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1546:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1547:     }
                   1548: 
                   1549:     # Add the graphic
1.179     matthew  1550:     my $title = &mt('View the FAQ');
1.215     albertel 1551:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1552:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1553:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1554: ENDTEMPLATE
                   1555:     if ($text ne '') { $template.='</td></tr></table>' };
                   1556:     return $template;
                   1557: 
1.44      bowersj2 1558: }
1.37      matthew  1559: 
1.180     matthew  1560: ###############################################################
                   1561: ###############################################################
                   1562: 
1.45      matthew  1563: =pod
                   1564: 
1.648     raeburn  1565: =item * &change_content_javascript():
1.256     matthew  1566: 
                   1567: This and the next function allow you to create small sections of an
                   1568: otherwise static HTML page that you can update on the fly with
                   1569: Javascript, even in Netscape 4.
                   1570: 
                   1571: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1572: must be written to the HTML page once. It will prove the Javascript
                   1573: function "change(name, content)". Calling the change function with the
                   1574: name of the section 
                   1575: you want to update, matching the name passed to C<changable_area>, and
                   1576: the new content you want to put in there, will put the content into
                   1577: that area.
                   1578: 
                   1579: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1580: to contain room for the original contents. You need to "make space"
                   1581: for whatever changes you wish to make, and be B<sure> to check your
                   1582: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1583: it's adequate for updating a one-line status display, but little more.
                   1584: This script will set the space to 100% width, so you only need to
                   1585: worry about height in Netscape 4.
                   1586: 
                   1587: Modern browsers are much less limiting, and if you can commit to the
                   1588: user not using Netscape 4, this feature may be used freely with
                   1589: pretty much any HTML.
                   1590: 
                   1591: =cut
                   1592: 
                   1593: sub change_content_javascript {
                   1594:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1595:     if ($env{'browser.type'} eq 'netscape' &&
                   1596: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1597: 	return (<<NETSCAPE4);
                   1598: 	function change(name, content) {
                   1599: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1600: 	    doc.open();
                   1601: 	    doc.write(content);
                   1602: 	    doc.close();
                   1603: 	}
                   1604: NETSCAPE4
                   1605:     } else {
                   1606: 	# Otherwise, we need to use semi-standards-compliant code
                   1607: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1608: 	# is really scary, and every useful browser supports it
                   1609: 	return (<<DOMBASED);
                   1610: 	function change(name, content) {
                   1611: 	    element = document.getElementById(name);
                   1612: 	    element.innerHTML = content;
                   1613: 	}
                   1614: DOMBASED
                   1615:     }
                   1616: }
                   1617: 
                   1618: =pod
                   1619: 
1.648     raeburn  1620: =item * &changable_area($name,$origContent):
1.256     matthew  1621: 
                   1622: This provides a "changable area" that can be modified on the fly via
                   1623: the Javascript code provided in C<change_content_javascript>. $name is
                   1624: the name you will use to reference the area later; do not repeat the
                   1625: same name on a given HTML page more then once. $origContent is what
                   1626: the area will originally contain, which can be left blank.
                   1627: 
                   1628: =cut
                   1629: 
                   1630: sub changable_area {
                   1631:     my ($name, $origContent) = @_;
                   1632: 
1.258     albertel 1633:     if ($env{'browser.type'} eq 'netscape' &&
                   1634: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1635: 	# If this is netscape 4, we need to use the Layer tag
                   1636: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1637:     } else {
                   1638: 	return "<span id='$name'>$origContent</span>";
                   1639:     }
                   1640: }
                   1641: 
                   1642: =pod
                   1643: 
1.648     raeburn  1644: =item * &viewport_geometry_js 
1.590     raeburn  1645: 
                   1646: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1647: 
                   1648: =cut
                   1649: 
                   1650: 
                   1651: sub viewport_geometry_js { 
                   1652:     return <<"GEOMETRY";
                   1653: var Geometry = {};
                   1654: function init_geometry() {
                   1655:     if (Geometry.init) { return };
                   1656:     Geometry.init=1;
                   1657:     if (window.innerHeight) {
                   1658:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1659:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1660:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1661:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1662:     }
                   1663:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1664:         Geometry.getViewportHeight =
                   1665:             function() { return document.documentElement.clientHeight; };
                   1666:         Geometry.getViewportWidth =
                   1667:             function() { return document.documentElement.clientWidth; };
                   1668: 
                   1669:         Geometry.getHorizontalScroll =
                   1670:             function() { return document.documentElement.scrollLeft; };
                   1671:         Geometry.getVerticalScroll =
                   1672:             function() { return document.documentElement.scrollTop; };
                   1673:     }
                   1674:     else if (document.body.clientHeight) {
                   1675:         Geometry.getViewportHeight =
                   1676:             function() { return document.body.clientHeight; };
                   1677:         Geometry.getViewportWidth =
                   1678:             function() { return document.body.clientWidth; };
                   1679:         Geometry.getHorizontalScroll =
                   1680:             function() { return document.body.scrollLeft; };
                   1681:         Geometry.getVerticalScroll =
                   1682:             function() { return document.body.scrollTop; };
                   1683:     }
                   1684: }
                   1685: 
                   1686: GEOMETRY
                   1687: }
                   1688: 
                   1689: =pod
                   1690: 
1.648     raeburn  1691: =item * &viewport_size_js()
1.590     raeburn  1692: 
                   1693: 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. 
                   1694: 
                   1695: =cut
                   1696: 
                   1697: sub viewport_size_js {
                   1698:     my $geometry = &viewport_geometry_js();
                   1699:     return <<"DIMS";
                   1700: 
                   1701: $geometry
                   1702: 
                   1703: function getViewportDims(width,height) {
                   1704:     init_geometry();
                   1705:     width.value = Geometry.getViewportWidth();
                   1706:     height.value = Geometry.getViewportHeight();
                   1707:     return;
                   1708: }
                   1709: 
                   1710: DIMS
                   1711: }
                   1712: 
                   1713: =pod
                   1714: 
1.648     raeburn  1715: =item * &resize_textarea_js()
1.565     albertel 1716: 
                   1717: emits the needed javascript to resize a textarea to be as big as possible
                   1718: 
                   1719: creates a function resize_textrea that takes two IDs first should be
                   1720: the id of the element to resize, second should be the id of a div that
                   1721: surrounds everything that comes after the textarea, this routine needs
                   1722: to be attached to the <body> for the onload and onresize events.
                   1723: 
1.648     raeburn  1724: =back
1.565     albertel 1725: 
                   1726: =cut
                   1727: 
                   1728: sub resize_textarea_js {
1.590     raeburn  1729:     my $geometry = &viewport_geometry_js();
1.565     albertel 1730:     return <<"RESIZE";
                   1731:     <script type="text/javascript">
1.824     bisitz   1732: // <![CDATA[
1.590     raeburn  1733: $geometry
1.565     albertel 1734: 
1.588     albertel 1735: function getX(element) {
                   1736:     var x = 0;
                   1737:     while (element) {
                   1738: 	x += element.offsetLeft;
                   1739: 	element = element.offsetParent;
                   1740:     }
                   1741:     return x;
                   1742: }
                   1743: function getY(element) {
                   1744:     var y = 0;
                   1745:     while (element) {
                   1746: 	y += element.offsetTop;
                   1747: 	element = element.offsetParent;
                   1748:     }
                   1749:     return y;
                   1750: }
                   1751: 
                   1752: 
1.565     albertel 1753: function resize_textarea(textarea_id,bottom_id) {
                   1754:     init_geometry();
                   1755:     var textarea        = document.getElementById(textarea_id);
                   1756:     //alert(textarea);
                   1757: 
1.588     albertel 1758:     var textarea_top    = getY(textarea);
1.565     albertel 1759:     var textarea_height = textarea.offsetHeight;
                   1760:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1761:     var bottom_top      = getY(bottom);
1.565     albertel 1762:     var bottom_height   = bottom.offsetHeight;
                   1763:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1764:     var fudge           = 23;
1.565     albertel 1765:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1766:     if (new_height < 300) {
                   1767: 	new_height = 300;
                   1768:     }
                   1769:     textarea.style.height=new_height+'px';
                   1770: }
1.824     bisitz   1771: // ]]>
1.565     albertel 1772: </script>
                   1773: RESIZE
                   1774: 
                   1775: }
                   1776: 
1.1205    golterma 1777: sub colorfuleditor_js {
                   1778:     return <<"COLORFULEDIT"
                   1779: <script type="text/javascript">
                   1780: // <![CDATA[>
                   1781:     function fold_box(curDepth, lastresource){
                   1782: 
                   1783:     // we need a list because there can be several blocks you need to fold in one tag
                   1784:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1785:     // but there is only one folding button per tag
                   1786:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1787: 
                   1788:         if(block.item(0).style.display == 'none'){
                   1789: 
                   1790:             foldbutton.value = '@{[&mt("Hide")]}';
                   1791:             for (i = 0; i < block.length; i++){
                   1792:                 block.item(i).style.display = '';
                   1793:             }
                   1794:         }else{
                   1795: 
                   1796:             foldbutton.value = '@{[&mt("Show")]}';
                   1797:             for (i = 0; i < block.length; i++){
                   1798:                 // block.item(i).style.visibility = 'collapse';
                   1799:                 block.item(i).style.display = 'none';
                   1800:             }
                   1801:         };
                   1802:         saveState(lastresource);
                   1803:     }
                   1804: 
                   1805:     function saveState (lastresource) {
                   1806: 
                   1807:         var tag_list = getTagList();
                   1808:         if(tag_list != null){
                   1809:             var timestamp = new Date().getTime();
                   1810:             var key = lastresource;
                   1811: 
                   1812:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1813:             // starting with timestamp
                   1814:             var value = timestamp+';';
                   1815: 
                   1816:             // building the list of key-value pairs
                   1817:             for(var i = 0; i < tag_list.length; i++){
                   1818:                 value += tag_list[i]+',';
                   1819:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1820:             }
                   1821: 
                   1822:             // only iterate whole storage if nothing to override
                   1823:             if(localStorage.getItem(key) == null){        
                   1824: 
                   1825:                 // prevent storage from growing large
                   1826:                 if(localStorage.length > 50){
                   1827:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1828:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1829:                     var oldest_key;
                   1830:                     
                   1831:                     for(var i = 1; i < localStorage.length; i++){
                   1832:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1833:                             oldest_key = localStorage.key(i);
                   1834:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1835:                         }
                   1836:                     }
                   1837:                     localStorage.removeItem(oldest_key);
                   1838:                 }
                   1839:             }
                   1840:             localStorage.setItem(key,value);
                   1841:         }
                   1842:     }
                   1843: 
                   1844:     // restore folding status of blocks (on page load)
                   1845:     function restoreState (lastresource) {
                   1846:         if(localStorage.getItem(lastresource) != null){
                   1847:             var key = lastresource;
                   1848:             var value = localStorage.getItem(key);
                   1849:             var regex_delTimestamp = /^\d+;/;
                   1850: 
                   1851:             value.replace(regex_delTimestamp, '');
                   1852: 
                   1853:             var valueArr = value.split(';');
                   1854:             var pairs;
                   1855:             var elements;
                   1856:             for (var i = 0; i < valueArr.length; i++){
                   1857:                 pairs = valueArr[i].split(',');
                   1858:                 elements = document.getElementsByName(pairs[0]);
                   1859: 
                   1860:                 for (var j = 0; j < elements.length; j++){  
                   1861:                     elements[j].style.display = pairs[1];
                   1862:                     if (pairs[1] == "none"){
                   1863:                         var regex_id = /([_\\d]+)\$/;
                   1864:                         regex_id.exec(pairs[0]);
                   1865:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   1866:                     }
                   1867:                 }
                   1868:             }
                   1869:         }
                   1870:     }
                   1871: 
                   1872:     function getTagList () {
                   1873:         
                   1874:         var stringToSearch = document.lonhomework.innerHTML;
                   1875: 
                   1876:         var ret = new Array();
                   1877:         var regex_findBlock = /(foldblock_.*?)"/g;
                   1878:         var tag_list = stringToSearch.match(regex_findBlock);
                   1879: 
                   1880:         if(tag_list != null){
                   1881:             for(var i = 0; i < tag_list.length; i++){            
                   1882:                 ret.push(tag_list[i].replace(/"/, ''));
                   1883:             }
                   1884:         }
                   1885:         return ret;
                   1886:     }
                   1887: 
                   1888:     function saveScrollPosition (resource) {
                   1889:         var tag_list = getTagList();
                   1890: 
                   1891:         // we dont always want to jump to the first block
                   1892:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   1893:         if(\$(window).scrollTop() > 170){
                   1894:             if(tag_list != null){
                   1895:                 var result;
                   1896:                 for(var i = 0; i < tag_list.length; i++){
                   1897:                     if(isElementInViewport(tag_list[i])){
                   1898:                         result += tag_list[i]+';';
                   1899:                     }
                   1900:                 }
                   1901:                 sessionStorage.setItem('anchor_'+resource, result);
                   1902:             }
                   1903:         } else {
                   1904:             // we dont need to save zero, just delete the item to leave everything tidy
                   1905:             sessionStorage.removeItem('anchor_'+resource);
                   1906:         }
                   1907:     }
                   1908: 
                   1909:     function restoreScrollPosition(resource){
                   1910: 
                   1911:         var elem = sessionStorage.getItem('anchor_'+resource);
                   1912:         if(elem != null){
                   1913:             var tag_list = elem.split(';');
                   1914:             var elem_list;
                   1915: 
                   1916:             for(var i = 0; i < tag_list.length; i++){
                   1917:                 elem_list = document.getElementsByName(tag_list[i]);
                   1918:                 
                   1919:                 if(elem_list.length > 0){
                   1920:                     elem = elem_list[0];
                   1921:                     break;
                   1922:                 }
                   1923:             }
                   1924:             elem.scrollIntoView();
                   1925:         }
                   1926:     }
                   1927: 
                   1928:     function isElementInViewport(el) {
                   1929: 
                   1930:         // change to last element instead of first
                   1931:         var elem = document.getElementsByName(el);
                   1932:         var rect = elem[0].getBoundingClientRect();
                   1933: 
                   1934:         return (
                   1935:             rect.top >= 0 &&
                   1936:             rect.left >= 0 &&
                   1937:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   1938:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   1939:         );
                   1940:     }
                   1941:     
                   1942:     function autosize(depth){
                   1943:         var cmInst = window['cm'+depth];
                   1944:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   1945: 
                   1946:         // is fixed size, switching to dynamic
                   1947:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   1948:             cmInst.setSize("","auto");
                   1949:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   1950:             sessionStorage.setItem("autosized_"+depth, "yes");
                   1951: 
                   1952:         // is dynamic size, switching to fixed
                   1953:         } else {
                   1954:             cmInst.setSize("","300px");
                   1955:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   1956:             sessionStorage.removeItem("autosized_"+depth);
                   1957:         }
                   1958:     }
                   1959: 
                   1960: 
                   1961: 
                   1962: // ]]>
                   1963: </script>
                   1964: COLORFULEDIT
                   1965: }
                   1966: 
                   1967: sub xmleditor_js {
                   1968:     return <<XMLEDIT
                   1969: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   1970: <script type="text/javascript">
                   1971: // <![CDATA[>
                   1972: 
                   1973:     function saveScrollPosition (resource) {
                   1974: 
                   1975:         var scrollPos = \$(window).scrollTop();
                   1976:         sessionStorage.setItem(resource,scrollPos);
                   1977:     }
                   1978: 
                   1979:     function restoreScrollPosition(resource){
                   1980: 
                   1981:         var scrollPos = sessionStorage.getItem(resource);
                   1982:         \$(window).scrollTop(scrollPos);
                   1983:     }
                   1984: 
                   1985:     // unless internet explorer
                   1986:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   1987: 
                   1988:         \$(document).ready(function() {
                   1989:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   1990:         });
                   1991:     }
                   1992: 
                   1993:     // inserts text at cursor position into codemirror (xml editor only)
                   1994:     function insertText(text){
                   1995:         cm.focus();
                   1996:         var curPos = cm.getCursor();
                   1997:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   1998:     }
                   1999: // ]]>
                   2000: </script>
                   2001: XMLEDIT
                   2002: }
                   2003: 
                   2004: sub insert_folding_button {
                   2005:     my $curDepth = $Apache::lonxml::curdepth;
                   2006:     my $lastresource = $env{'request.ambiguous'};
                   2007: 
                   2008:     return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
                   2009:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2010: }
                   2011: 
1.565     albertel 2012: =pod
                   2013: 
1.256     matthew  2014: =head1 Excel and CSV file utility routines
                   2015: 
                   2016: =cut
                   2017: 
                   2018: ###############################################################
                   2019: ###############################################################
                   2020: 
                   2021: =pod
                   2022: 
1.1162    raeburn  2023: =over 4
                   2024: 
1.648     raeburn  2025: =item * &csv_translate($text) 
1.37      matthew  2026: 
1.185     www      2027: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2028: format.
                   2029: 
                   2030: =cut
                   2031: 
1.180     matthew  2032: ###############################################################
                   2033: ###############################################################
1.37      matthew  2034: sub csv_translate {
                   2035:     my $text = shift;
                   2036:     $text =~ s/\"/\"\"/g;
1.209     albertel 2037:     $text =~ s/\n/ /g;
1.37      matthew  2038:     return $text;
                   2039: }
1.180     matthew  2040: 
                   2041: ###############################################################
                   2042: ###############################################################
                   2043: 
                   2044: =pod
                   2045: 
1.648     raeburn  2046: =item * &define_excel_formats()
1.180     matthew  2047: 
                   2048: Define some commonly used Excel cell formats.
                   2049: 
                   2050: Currently supported formats:
                   2051: 
                   2052: =over 4
                   2053: 
                   2054: =item header
                   2055: 
                   2056: =item bold
                   2057: 
                   2058: =item h1
                   2059: 
                   2060: =item h2
                   2061: 
                   2062: =item h3
                   2063: 
1.256     matthew  2064: =item h4
                   2065: 
                   2066: =item i
                   2067: 
1.180     matthew  2068: =item date
                   2069: 
                   2070: =back
                   2071: 
                   2072: Inputs: $workbook
                   2073: 
                   2074: Returns: $format, a hash reference.
                   2075: 
1.1057    foxr     2076: 
1.180     matthew  2077: =cut
                   2078: 
                   2079: ###############################################################
                   2080: ###############################################################
                   2081: sub define_excel_formats {
                   2082:     my ($workbook) = @_;
                   2083:     my $format;
                   2084:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2085:                                                 bottom    => 1,
                   2086:                                                 align     => 'center');
                   2087:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2088:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2089:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2090:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2091:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2092:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2093:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2094:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2095:     return $format;
                   2096: }
                   2097: 
                   2098: ###############################################################
                   2099: ###############################################################
1.113     bowersj2 2100: 
                   2101: =pod
                   2102: 
1.648     raeburn  2103: =item * &create_workbook()
1.255     matthew  2104: 
                   2105: Create an Excel worksheet.  If it fails, output message on the
                   2106: request object and return undefs.
                   2107: 
                   2108: Inputs: Apache request object
                   2109: 
                   2110: Returns (undef) on failure, 
                   2111:     Excel worksheet object, scalar with filename, and formats 
                   2112:     from &Apache::loncommon::define_excel_formats on success
                   2113: 
                   2114: =cut
                   2115: 
                   2116: ###############################################################
                   2117: ###############################################################
                   2118: sub create_workbook {
                   2119:     my ($r) = @_;
                   2120:         #
                   2121:     # Create the excel spreadsheet
                   2122:     my $filename = '/prtspool/'.
1.258     albertel 2123:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2124:         time.'_'.rand(1000000000).'.xls';
                   2125:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2126:     if (! defined($workbook)) {
                   2127:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2128:         $r->print(
                   2129:             '<p class="LC_error">'
                   2130:            .&mt('Problems occurred in creating the new Excel file.')
                   2131:            .' '.&mt('This error has been logged.')
                   2132:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2133:            .'</p>'
                   2134:         );
1.255     matthew  2135:         return (undef);
                   2136:     }
                   2137:     #
1.1014    foxr     2138:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2139:     #
                   2140:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2141:     return ($workbook,$filename,$format);
                   2142: }
                   2143: 
                   2144: ###############################################################
                   2145: ###############################################################
                   2146: 
                   2147: =pod
                   2148: 
1.648     raeburn  2149: =item * &create_text_file()
1.113     bowersj2 2150: 
1.542     raeburn  2151: Create a file to write to and eventually make available to the user.
1.256     matthew  2152: If file creation fails, outputs an error message on the request object and 
                   2153: return undefs.
1.113     bowersj2 2154: 
1.256     matthew  2155: Inputs: Apache request object, and file suffix
1.113     bowersj2 2156: 
1.256     matthew  2157: Returns (undef) on failure, 
                   2158:     Filehandle and filename on success.
1.113     bowersj2 2159: 
                   2160: =cut
                   2161: 
1.256     matthew  2162: ###############################################################
                   2163: ###############################################################
                   2164: sub create_text_file {
                   2165:     my ($r,$suffix) = @_;
                   2166:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2167:     my $fh;
                   2168:     my $filename = '/prtspool/'.
1.258     albertel 2169:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2170:         time.'_'.rand(1000000000).'.'.$suffix;
                   2171:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2172:     if (! defined($fh)) {
                   2173:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2174:         $r->print(
                   2175:             '<p class="LC_error">'
                   2176:            .&mt('Problems occurred in creating the output file.')
                   2177:            .' '.&mt('This error has been logged.')
                   2178:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2179:            .'</p>'
                   2180:         );
1.113     bowersj2 2181:     }
1.256     matthew  2182:     return ($fh,$filename)
1.113     bowersj2 2183: }
                   2184: 
                   2185: 
1.256     matthew  2186: =pod 
1.113     bowersj2 2187: 
                   2188: =back
                   2189: 
                   2190: =cut
1.37      matthew  2191: 
                   2192: ###############################################################
1.33      matthew  2193: ##        Home server <option> list generating code          ##
                   2194: ###############################################################
1.35      matthew  2195: 
1.169     www      2196: # ------------------------------------------
                   2197: 
                   2198: sub domain_select {
                   2199:     my ($name,$value,$multiple)=@_;
                   2200:     my %domains=map { 
1.514     albertel 2201: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 2202:     } &Apache::lonnet::all_domains();
1.169     www      2203:     if ($multiple) {
                   2204: 	$domains{''}=&mt('Any domain');
1.550     albertel 2205: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2206: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2207:     } else {
1.550     albertel 2208: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2209: 	return &select_form($name,$value,\%domains);
1.169     www      2210:     }
                   2211: }
                   2212: 
1.282     albertel 2213: #-------------------------------------------
                   2214: 
                   2215: =pod
                   2216: 
1.519     raeburn  2217: =head1 Routines for form select boxes
                   2218: 
                   2219: =over 4
                   2220: 
1.648     raeburn  2221: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2222: 
                   2223: Returns a string containing a <select> element int multiple mode
                   2224: 
                   2225: 
                   2226: Args:
                   2227:   $name - name of the <select> element
1.506     raeburn  2228:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2229:   $size - number of rows long the select element is
1.283     albertel 2230:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2231:           (shown text should already have been &mt())
1.506     raeburn  2232:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2233: 
1.282     albertel 2234: =cut
                   2235: 
                   2236: #-------------------------------------------
1.169     www      2237: sub multiple_select_form {
1.284     albertel 2238:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2239:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2240:     my $output='';
1.191     matthew  2241:     if (! defined($size)) {
                   2242:         $size = 4;
1.283     albertel 2243:         if (scalar(keys(%$hash))<4) {
                   2244:             $size = scalar(keys(%$hash));
1.191     matthew  2245:         }
                   2246:     }
1.734     bisitz   2247:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2248:     my @order;
1.506     raeburn  2249:     if (ref($order) eq 'ARRAY')  {
                   2250:         @order = @{$order};
                   2251:     } else {
                   2252:         @order = sort(keys(%$hash));
1.501     banghart 2253:     }
                   2254:     if (exists($$hash{'select_form_order'})) {
                   2255:         @order = @{$$hash{'select_form_order'}};
                   2256:     }
                   2257:         
1.284     albertel 2258:     foreach my $key (@order) {
1.356     albertel 2259:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2260:         $output.='selected="selected" ' if ($selected{$key});
                   2261:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2262:     }
                   2263:     $output.="</select>\n";
                   2264:     return $output;
                   2265: }
                   2266: 
1.88      www      2267: #-------------------------------------------
                   2268: 
                   2269: =pod
                   2270: 
1.970     raeburn  2271: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2272: 
                   2273: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2274: allow a user to select options from a ref to a hash containing:
                   2275: option_name => displayed text. An optional $onchange can include
                   2276: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2277: 
1.88      www      2278: See lonrights.pm for an example invocation and use.
                   2279: 
                   2280: =cut
                   2281: 
                   2282: #-------------------------------------------
                   2283: sub select_form {
1.1228    raeburn  2284:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2285:     return unless (ref($hashref) eq 'HASH');
                   2286:     if ($onchange) {
                   2287:         $onchange = ' onchange="'.$onchange.'"';
                   2288:     }
1.1228    raeburn  2289:     my $disabled;
                   2290:     if ($readonly) {
                   2291:         $disabled = ' disabled="disabled"';
                   2292:     }
                   2293:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2294:     my @keys;
1.970     raeburn  2295:     if (exists($hashref->{'select_form_order'})) {
                   2296: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2297:     } else {
1.970     raeburn  2298: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2299:     }
1.356     albertel 2300:     foreach my $key (@keys) {
                   2301:         $selectform.=
                   2302: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2303:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2304:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2305:     }
                   2306:     $selectform.="</select>";
                   2307:     return $selectform;
                   2308: }
                   2309: 
1.475     www      2310: # For display filters
                   2311: 
                   2312: sub display_filter {
1.1074    raeburn  2313:     my ($context) = @_;
1.475     www      2314:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2315:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2316:     my $phraseinput = 'hidden';
                   2317:     my $includeinput = 'hidden';
                   2318:     my ($checked,$includetypestext);
                   2319:     if ($env{'form.displayfilter'} eq 'containing') {
                   2320:         $phraseinput = 'text'; 
                   2321:         if ($context eq 'parmslog') {
                   2322:             $includeinput = 'checkbox';
                   2323:             if ($env{'form.includetypes'}) {
                   2324:                 $checked = ' checked="checked"';
                   2325:             }
                   2326:             $includetypestext = &mt('Include parameter types');
                   2327:         }
                   2328:     } else {
                   2329:         $includetypestext = '&nbsp;';
                   2330:     }
                   2331:     my ($additional,$secondid,$thirdid);
                   2332:     if ($context eq 'parmslog') {
                   2333:         $additional = 
                   2334:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2335:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2336:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2337:             '</label>';
                   2338:         $secondid = 'includetypes';
                   2339:         $thirdid = 'includetypestext';
                   2340:     }
                   2341:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2342:                                                     '$secondid','$thirdid')";
                   2343:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2344: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2345: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2346: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2347:            &mt('Filter: [_1]',
1.477     www      2348: 	   &select_form($env{'form.displayfilter'},
                   2349: 			'displayfilter',
1.970     raeburn  2350: 			{'currentfolder' => 'Current folder/page',
1.477     www      2351: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2352: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2353: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2354:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2355:                          '" />'.$additional;
                   2356: }
                   2357: 
                   2358: sub display_filter_js {
                   2359:     my $includetext = &mt('Include parameter types');
                   2360:     return <<"ENDJS";
                   2361:   
                   2362: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2363:     var firstType = 'hidden';
                   2364:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2365:         firstType = 'text';
                   2366:     }
                   2367:     firstObject = document.getElementById(firstid);
                   2368:     if (typeof(firstObject) == 'object') {
                   2369:         if (firstObject.type != firstType) {
                   2370:             changeInputType(firstObject,firstType);
                   2371:         }
                   2372:     }
                   2373:     if (context == 'parmslog') {
                   2374:         var secondType = 'hidden';
                   2375:         if (firstType == 'text') {
                   2376:             secondType = 'checkbox';
                   2377:         }
                   2378:         secondObject = document.getElementById(secondid);  
                   2379:         if (typeof(secondObject) == 'object') {
                   2380:             if (secondObject.type != secondType) {
                   2381:                 changeInputType(secondObject,secondType);
                   2382:             }
                   2383:         }
                   2384:         var textItem = document.getElementById(thirdid);
                   2385:         var currtext = textItem.innerHTML;
                   2386:         var newtext;
                   2387:         if (firstType == 'text') {
                   2388:             newtext = '$includetext';
                   2389:         } else {
                   2390:             newtext = '&nbsp;';
                   2391:         }
                   2392:         if (currtext != newtext) {
                   2393:             textItem.innerHTML = newtext;
                   2394:         }
                   2395:     }
                   2396:     return;
                   2397: }
                   2398: 
                   2399: function changeInputType(oldObject,newType) {
                   2400:     var newObject = document.createElement('input');
                   2401:     newObject.type = newType;
                   2402:     if (oldObject.size) {
                   2403:         newObject.size = oldObject.size;
                   2404:     }
                   2405:     if (oldObject.value) {
                   2406:         newObject.value = oldObject.value;
                   2407:     }
                   2408:     if (oldObject.name) {
                   2409:         newObject.name = oldObject.name;
                   2410:     }
                   2411:     if (oldObject.id) {
                   2412:         newObject.id = oldObject.id;
                   2413:     }
                   2414:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2415:     return;
                   2416: }
                   2417: 
                   2418: ENDJS
1.475     www      2419: }
                   2420: 
1.167     www      2421: sub gradeleveldescription {
                   2422:     my $gradelevel=shift;
                   2423:     my %gradelevels=(0 => 'Not specified',
                   2424: 		     1 => 'Grade 1',
                   2425: 		     2 => 'Grade 2',
                   2426: 		     3 => 'Grade 3',
                   2427: 		     4 => 'Grade 4',
                   2428: 		     5 => 'Grade 5',
                   2429: 		     6 => 'Grade 6',
                   2430: 		     7 => 'Grade 7',
                   2431: 		     8 => 'Grade 8',
                   2432: 		     9 => 'Grade 9',
                   2433: 		     10 => 'Grade 10',
                   2434: 		     11 => 'Grade 11',
                   2435: 		     12 => 'Grade 12',
                   2436: 		     13 => 'Grade 13',
                   2437: 		     14 => '100 Level',
                   2438: 		     15 => '200 Level',
                   2439: 		     16 => '300 Level',
                   2440: 		     17 => '400 Level',
                   2441: 		     18 => 'Graduate Level');
                   2442:     return &mt($gradelevels{$gradelevel});
                   2443: }
                   2444: 
1.163     www      2445: sub select_level_form {
                   2446:     my ($deflevel,$name)=@_;
                   2447:     unless ($deflevel) { $deflevel=0; }
1.167     www      2448:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2449:     for (my $i=0; $i<=18; $i++) {
                   2450:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2451:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2452:                 ">".&gradeleveldescription($i)."</option>\n";
                   2453:     }
                   2454:     $selectform.="</select>";
                   2455:     return $selectform;
1.163     www      2456: }
1.167     www      2457: 
1.35      matthew  2458: #-------------------------------------------
                   2459: 
1.45      matthew  2460: =pod
                   2461: 
1.1121    raeburn  2462: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2463: 
                   2464: Returns a string containing a <select name='$name' size='1'> form to 
                   2465: allow a user to select the domain to preform an operation in.  
                   2466: See loncreateuser.pm for an example invocation and use.
                   2467: 
1.90      www      2468: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2469: selected");
                   2470: 
1.743     raeburn  2471: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2472: 
1.910     raeburn  2473: 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.
                   2474: 
1.1121    raeburn  2475: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2476: 
                   2477: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2478: 
1.35      matthew  2479: =cut
                   2480: 
                   2481: #-------------------------------------------
1.34      matthew  2482: sub select_dom_form {
1.1121    raeburn  2483:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2484:     if ($onchange) {
1.874     raeburn  2485:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2486:     }
1.1121    raeburn  2487:     my (@domains,%exclude);
1.910     raeburn  2488:     if (ref($incdoms) eq 'ARRAY') {
                   2489:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2490:     } else {
                   2491:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2492:     }
1.90      www      2493:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2494:     if (ref($excdoms) eq 'ARRAY') {
                   2495:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2496:     }
1.743     raeburn  2497:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2498:     foreach my $dom (@domains) {
1.1121    raeburn  2499:         next if ($exclude{$dom});
1.356     albertel 2500:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2501:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2502:         if ($showdomdesc) {
                   2503:             if ($dom ne '') {
                   2504:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2505:                 if ($domdesc ne '') {
                   2506:                     $selectdomain .= ' ('.$domdesc.')';
                   2507:                 }
                   2508:             } 
                   2509:         }
                   2510:         $selectdomain .= "</option>\n";
1.34      matthew  2511:     }
                   2512:     $selectdomain.="</select>";
                   2513:     return $selectdomain;
                   2514: }
                   2515: 
1.35      matthew  2516: #-------------------------------------------
                   2517: 
1.45      matthew  2518: =pod
                   2519: 
1.648     raeburn  2520: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2521: 
1.586     raeburn  2522: input: 4 arguments (two required, two optional) - 
                   2523:     $domain - domain of new user
                   2524:     $name - name of form element
                   2525:     $default - Value of 'default' causes a default item to be first 
                   2526:                             option, and selected by default. 
                   2527:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2528:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2529: output: returns 2 items: 
1.586     raeburn  2530: (a) form element which contains either:
                   2531:    (i) <select name="$name">
                   2532:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2533:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2534:        </select>
                   2535:        form item if there are multiple library servers in $domain, or
                   2536:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2537:        if there is only one library server in $domain.
                   2538: 
                   2539: (b) number of library servers found.
                   2540: 
                   2541: See loncreateuser.pm for example of use.
1.35      matthew  2542: 
                   2543: =cut
                   2544: 
                   2545: #-------------------------------------------
1.586     raeburn  2546: sub home_server_form_item {
                   2547:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2548:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2549:     my $result;
                   2550:     my $numlib = keys(%servers);
                   2551:     if ($numlib > 1) {
                   2552:         $result .= '<select name="'.$name.'" />'."\n";
                   2553:         if ($default) {
1.804     bisitz   2554:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2555:                        '</option>'."\n";
                   2556:         }
                   2557:         foreach my $hostid (sort(keys(%servers))) {
                   2558:             $result.= '<option value="'.$hostid.'">'.
                   2559: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2560:         }
                   2561:         $result .= '</select>'."\n";
                   2562:     } elsif ($numlib == 1) {
                   2563:         my $hostid;
                   2564:         foreach my $item (keys(%servers)) {
                   2565:             $hostid = $item;
                   2566:         }
                   2567:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2568:                    $hostid.'" />';
                   2569:                    if (!$hide) {
                   2570:                        $result .= $hostid.' '.$servers{$hostid};
                   2571:                    }
                   2572:                    $result .= "\n";
                   2573:     } elsif ($default) {
                   2574:         $result .= '<input type="hidden" name="'.$name.
                   2575:                    '" value="default" />';
                   2576:                    if (!$hide) {
                   2577:                        $result .= &mt('default');
                   2578:                    }
                   2579:                    $result .= "\n";
1.33      matthew  2580:     }
1.586     raeburn  2581:     return ($result,$numlib);
1.33      matthew  2582: }
1.112     bowersj2 2583: 
                   2584: =pod
                   2585: 
1.534     albertel 2586: =back 
                   2587: 
1.112     bowersj2 2588: =cut
1.87      matthew  2589: 
                   2590: ###############################################################
1.112     bowersj2 2591: ##                  Decoding User Agent                      ##
1.87      matthew  2592: ###############################################################
                   2593: 
                   2594: =pod
                   2595: 
1.112     bowersj2 2596: =head1 Decoding the User Agent
                   2597: 
                   2598: =over 4
                   2599: 
                   2600: =item * &decode_user_agent()
1.87      matthew  2601: 
                   2602: Inputs: $r
                   2603: 
                   2604: Outputs:
                   2605: 
                   2606: =over 4
                   2607: 
1.112     bowersj2 2608: =item * $httpbrowser
1.87      matthew  2609: 
1.112     bowersj2 2610: =item * $clientbrowser
1.87      matthew  2611: 
1.112     bowersj2 2612: =item * $clientversion
1.87      matthew  2613: 
1.112     bowersj2 2614: =item * $clientmathml
1.87      matthew  2615: 
1.112     bowersj2 2616: =item * $clientunicode
1.87      matthew  2617: 
1.112     bowersj2 2618: =item * $clientos
1.87      matthew  2619: 
1.1137    raeburn  2620: =item * $clientmobile
                   2621: 
1.1141    raeburn  2622: =item * $clientinfo
                   2623: 
1.1194    raeburn  2624: =item * $clientosversion
                   2625: 
1.87      matthew  2626: =back
                   2627: 
1.157     matthew  2628: =back 
                   2629: 
1.87      matthew  2630: =cut
                   2631: 
                   2632: ###############################################################
                   2633: ###############################################################
                   2634: sub decode_user_agent {
1.247     albertel 2635:     my ($r)=@_;
1.87      matthew  2636:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2637:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2638:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2639:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2640:     my $clientbrowser='unknown';
                   2641:     my $clientversion='0';
                   2642:     my $clientmathml='';
                   2643:     my $clientunicode='0';
1.1137    raeburn  2644:     my $clientmobile=0;
1.1194    raeburn  2645:     my $clientosversion='';
1.87      matthew  2646:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1193    raeburn  2647:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2648: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2649: 	    $clientbrowser=$bname;
                   2650:             $httpbrowser=~/$vreg/i;
                   2651: 	    $clientversion=$1;
                   2652:             $clientmathml=($clientversion>=$minv);
                   2653:             $clientunicode=($clientversion>=$univ);
                   2654: 	}
                   2655:     }
                   2656:     my $clientos='unknown';
1.1141    raeburn  2657:     my $clientinfo;
1.87      matthew  2658:     if (($httpbrowser=~/linux/i) ||
                   2659:         ($httpbrowser=~/unix/i) ||
                   2660:         ($httpbrowser=~/ux/i) ||
                   2661:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2662:     if (($httpbrowser=~/vax/i) ||
                   2663:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2664:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2665:     if (($httpbrowser=~/mac/i) ||
                   2666:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194    raeburn  2667:     if ($httpbrowser=~/win/i) {
                   2668:         $clientos='win';
                   2669:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2670:             $clientosversion = $1;
                   2671:         }
                   2672:     }
1.87      matthew  2673:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2674:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2675:         $clientmobile=lc($1);
                   2676:     }
1.1141    raeburn  2677:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2678:         $clientinfo = 'firefox-'.$1;
                   2679:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2680:         $clientinfo = 'chromeframe-'.$1;
                   2681:     }
1.87      matthew  2682:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194    raeburn  2683:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2684:             $clientosversion);
1.87      matthew  2685: }
                   2686: 
1.32      matthew  2687: ###############################################################
                   2688: ##    Authentication changing form generation subroutines    ##
                   2689: ###############################################################
                   2690: ##
                   2691: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2692: ## hash, and have reasonable default values.
                   2693: ##
                   2694: ##    formname = the name given in the <form> tag.
1.35      matthew  2695: #-------------------------------------------
                   2696: 
1.45      matthew  2697: =pod
                   2698: 
1.112     bowersj2 2699: =head1 Authentication Routines
                   2700: 
                   2701: =over 4
                   2702: 
1.648     raeburn  2703: =item * &authform_xxxxxx()
1.35      matthew  2704: 
                   2705: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2706: handle some of the conveniences required for authentication forms.  
                   2707: This is not an optimal method, but it works.  
                   2708: 
                   2709: =over 4
                   2710: 
1.112     bowersj2 2711: =item * authform_header
1.35      matthew  2712: 
1.112     bowersj2 2713: =item * authform_authorwarning
1.35      matthew  2714: 
1.112     bowersj2 2715: =item * authform_nochange
1.35      matthew  2716: 
1.112     bowersj2 2717: =item * authform_kerberos
1.35      matthew  2718: 
1.112     bowersj2 2719: =item * authform_internal
1.35      matthew  2720: 
1.112     bowersj2 2721: =item * authform_filesystem
1.35      matthew  2722: 
                   2723: =back
                   2724: 
1.648     raeburn  2725: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2726: 
1.35      matthew  2727: =cut
                   2728: 
                   2729: #-------------------------------------------
1.32      matthew  2730: sub authform_header{  
                   2731:     my %in = (
                   2732:         formname => 'cu',
1.80      albertel 2733:         kerb_def_dom => '',
1.32      matthew  2734:         @_,
                   2735:     );
                   2736:     $in{'formname'} = 'document.' . $in{'formname'};
                   2737:     my $result='';
1.80      albertel 2738: 
                   2739: #---------------------------------------------- Code for upper case translation
                   2740:     my $Javascript_toUpperCase;
                   2741:     unless ($in{kerb_def_dom}) {
                   2742:         $Javascript_toUpperCase =<<"END";
                   2743:         switch (choice) {
                   2744:            case 'krb': currentform.elements[choicearg].value =
                   2745:                currentform.elements[choicearg].value.toUpperCase();
                   2746:                break;
                   2747:            default:
                   2748:         }
                   2749: END
                   2750:     } else {
                   2751:         $Javascript_toUpperCase = "";
                   2752:     }
                   2753: 
1.165     raeburn  2754:     my $radioval = "'nochange'";
1.591     raeburn  2755:     if (defined($in{'curr_authtype'})) {
                   2756:         if ($in{'curr_authtype'} ne '') {
                   2757:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2758:         }
1.174     matthew  2759:     }
1.165     raeburn  2760:     my $argfield = 'null';
1.591     raeburn  2761:     if (defined($in{'mode'})) {
1.165     raeburn  2762:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2763:             if (defined($in{'curr_autharg'})) {
                   2764:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2765:                     $argfield = "'$in{'curr_autharg'}'";
                   2766:                 }
                   2767:             }
                   2768:         }
                   2769:     }
                   2770: 
1.32      matthew  2771:     $result.=<<"END";
                   2772: var current = new Object();
1.165     raeburn  2773: current.radiovalue = $radioval;
                   2774: current.argfield = $argfield;
1.32      matthew  2775: 
                   2776: function changed_radio(choice,currentform) {
                   2777:     var choicearg = choice + 'arg';
                   2778:     // If a radio button in changed, we need to change the argfield
                   2779:     if (current.radiovalue != choice) {
                   2780:         current.radiovalue = choice;
                   2781:         if (current.argfield != null) {
                   2782:             currentform.elements[current.argfield].value = '';
                   2783:         }
                   2784:         if (choice == 'nochange') {
                   2785:             current.argfield = null;
                   2786:         } else {
                   2787:             current.argfield = choicearg;
                   2788:             switch(choice) {
                   2789:                 case 'krb': 
                   2790:                     currentform.elements[current.argfield].value = 
                   2791:                         "$in{'kerb_def_dom'}";
                   2792:                 break;
                   2793:               default:
                   2794:                 break;
                   2795:             }
                   2796:         }
                   2797:     }
                   2798:     return;
                   2799: }
1.22      www      2800: 
1.32      matthew  2801: function changed_text(choice,currentform) {
                   2802:     var choicearg = choice + 'arg';
                   2803:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2804:         $Javascript_toUpperCase
1.32      matthew  2805:         // clear old field
                   2806:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2807:             currentform.elements[current.argfield].value = '';
                   2808:         }
                   2809:         current.argfield = choicearg;
                   2810:     }
                   2811:     set_auth_radio_buttons(choice,currentform);
                   2812:     return;
1.20      www      2813: }
1.32      matthew  2814: 
                   2815: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2816:     var numauthchoices = currentform.login.length;
                   2817:     if (typeof numauthchoices  == "undefined") {
                   2818:         return;
                   2819:     } 
1.32      matthew  2820:     var i=0;
1.986     raeburn  2821:     while (i < numauthchoices) {
1.32      matthew  2822:         if (currentform.login[i].value == newvalue) { break; }
                   2823:         i++;
                   2824:     }
1.986     raeburn  2825:     if (i == numauthchoices) {
1.32      matthew  2826:         return;
                   2827:     }
                   2828:     current.radiovalue = newvalue;
                   2829:     currentform.login[i].checked = true;
                   2830:     return;
                   2831: }
                   2832: END
                   2833:     return $result;
                   2834: }
                   2835: 
1.1106    raeburn  2836: sub authform_authorwarning {
1.32      matthew  2837:     my $result='';
1.144     matthew  2838:     $result='<i>'.
                   2839:         &mt('As a general rule, only authors or co-authors should be '.
                   2840:             'filesystem authenticated '.
                   2841:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2842:     return $result;
                   2843: }
                   2844: 
1.1106    raeburn  2845: sub authform_nochange {
1.32      matthew  2846:     my %in = (
                   2847:               formname => 'document.cu',
                   2848:               kerb_def_dom => 'MSU.EDU',
                   2849:               @_,
                   2850:           );
1.1106    raeburn  2851:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2852:     my $result;
1.1104    raeburn  2853:     if (!$authnum) {
1.1105    raeburn  2854:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2855:     } else {
                   2856:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2857:                   '<input type="radio" name="login" value="nochange" '.
                   2858:                   'checked="checked" onclick="'.
1.281     albertel 2859:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2860: 	    '</label>';
1.586     raeburn  2861:     }
1.32      matthew  2862:     return $result;
                   2863: }
                   2864: 
1.591     raeburn  2865: sub authform_kerberos {
1.32      matthew  2866:     my %in = (
                   2867:               formname => 'document.cu',
                   2868:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2869:               kerb_def_auth => 'krb4',
1.32      matthew  2870:               @_,
                   2871:               );
1.586     raeburn  2872:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2873:         $autharg,$jscall);
1.1106    raeburn  2874:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2875:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2876:        $check5 = ' checked="checked"';
1.80      albertel 2877:     } else {
1.772     bisitz   2878:        $check4 = ' checked="checked"';
1.80      albertel 2879:     }
1.165     raeburn  2880:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2881:     if (defined($in{'curr_authtype'})) {
                   2882:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2883:             $krbcheck = ' checked="checked"';
1.623     raeburn  2884:             if (defined($in{'mode'})) {
                   2885:                 if ($in{'mode'} eq 'modifyuser') {
                   2886:                     $krbcheck = '';
                   2887:                 }
                   2888:             }
1.591     raeburn  2889:             if (defined($in{'curr_kerb_ver'})) {
                   2890:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2891:                     $check5 = ' checked="checked"';
1.591     raeburn  2892:                     $check4 = '';
                   2893:                 } else {
1.772     bisitz   2894:                     $check4 = ' checked="checked"';
1.591     raeburn  2895:                     $check5 = '';
                   2896:                 }
1.586     raeburn  2897:             }
1.591     raeburn  2898:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2899:                 $krbarg = $in{'curr_autharg'};
                   2900:             }
1.586     raeburn  2901:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2902:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2903:                     $result = 
                   2904:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2905:         $in{'curr_autharg'},$krbver);
                   2906:                 } else {
                   2907:                     $result =
                   2908:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2909:                 }
                   2910:                 return $result; 
                   2911:             }
                   2912:         }
                   2913:     } else {
                   2914:         if ($authnum == 1) {
1.784     bisitz   2915:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2916:         }
                   2917:     }
1.586     raeburn  2918:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2919:         return;
1.587     raeburn  2920:     } elsif ($authtype eq '') {
1.591     raeburn  2921:         if (defined($in{'mode'})) {
1.587     raeburn  2922:             if ($in{'mode'} eq 'modifycourse') {
                   2923:                 if ($authnum == 1) {
1.1104    raeburn  2924:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2925:                 }
                   2926:             }
                   2927:         }
1.586     raeburn  2928:     }
                   2929:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2930:     if ($authtype eq '') {
                   2931:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2932:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2933:                     $krbcheck.' />';
                   2934:     }
                   2935:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2936:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2937:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2938:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2939:          $in{'curr_authtype'} eq 'krb4')) {
                   2940:         $result .= &mt
1.144     matthew  2941:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2942:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2943:          '<label>'.$authtype,
1.281     albertel 2944:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2945:              'value="'.$krbarg.'" '.
1.144     matthew  2946:              'onchange="'.$jscall.'" />',
1.281     albertel 2947:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2948:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2949: 	 '</label>');
1.586     raeburn  2950:     } elsif ($can_assign{'krb4'}) {
                   2951:         $result .= &mt
                   2952:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2953:          '[_3] Version 4 [_4]',
                   2954:          '<label>'.$authtype,
                   2955:          '</label><input type="text" size="10" name="krbarg" '.
                   2956:              'value="'.$krbarg.'" '.
                   2957:              'onchange="'.$jscall.'" />',
                   2958:          '<label><input type="hidden" name="krbver" value="4" />',
                   2959:          '</label>');
                   2960:     } elsif ($can_assign{'krb5'}) {
                   2961:         $result .= &mt
                   2962:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2963:          '[_3] Version 5 [_4]',
                   2964:          '<label>'.$authtype,
                   2965:          '</label><input type="text" size="10" name="krbarg" '.
                   2966:              'value="'.$krbarg.'" '.
                   2967:              'onchange="'.$jscall.'" />',
                   2968:          '<label><input type="hidden" name="krbver" value="5" />',
                   2969:          '</label>');
                   2970:     }
1.32      matthew  2971:     return $result;
                   2972: }
                   2973: 
1.1106    raeburn  2974: sub authform_internal {
1.586     raeburn  2975:     my %in = (
1.32      matthew  2976:                 formname => 'document.cu',
                   2977:                 kerb_def_dom => 'MSU.EDU',
                   2978:                 @_,
                   2979:                 );
1.586     raeburn  2980:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2981:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2982:     if (defined($in{'curr_authtype'})) {
                   2983:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2984:             if ($can_assign{'int'}) {
1.772     bisitz   2985:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2986:                 if (defined($in{'mode'})) {
                   2987:                     if ($in{'mode'} eq 'modifyuser') {
                   2988:                         $intcheck = '';
                   2989:                     }
                   2990:                 }
1.591     raeburn  2991:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2992:                     $intarg = $in{'curr_autharg'};
                   2993:                 }
                   2994:             } else {
                   2995:                 $result = &mt('Currently internally authenticated.');
                   2996:                 return $result;
1.165     raeburn  2997:             }
                   2998:         }
1.586     raeburn  2999:     } else {
                   3000:         if ($authnum == 1) {
1.784     bisitz   3001:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  3002:         }
                   3003:     }
                   3004:     if (!$can_assign{'int'}) {
                   3005:         return;
1.587     raeburn  3006:     } elsif ($authtype eq '') {
1.591     raeburn  3007:         if (defined($in{'mode'})) {
1.587     raeburn  3008:             if ($in{'mode'} eq 'modifycourse') {
                   3009:                 if ($authnum == 1) {
1.1104    raeburn  3010:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  3011:                 }
                   3012:             }
                   3013:         }
1.165     raeburn  3014:     }
1.586     raeburn  3015:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3016:     if ($authtype eq '') {
                   3017:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   3018:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   3019:     }
1.605     bisitz   3020:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  3021:                $intarg.'" onchange="'.$jscall.'" />';
                   3022:     $result = &mt
1.144     matthew  3023:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3024:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   3025:     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  3026:     return $result;
                   3027: }
                   3028: 
1.1104    raeburn  3029: sub authform_local {
1.32      matthew  3030:     my %in = (
                   3031:               formname => 'document.cu',
                   3032:               kerb_def_dom => 'MSU.EDU',
                   3033:               @_,
                   3034:               );
1.586     raeburn  3035:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3036:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3037:     if (defined($in{'curr_authtype'})) {
                   3038:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3039:             if ($can_assign{'loc'}) {
1.772     bisitz   3040:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3041:                 if (defined($in{'mode'})) {
                   3042:                     if ($in{'mode'} eq 'modifyuser') {
                   3043:                         $loccheck = '';
                   3044:                     }
                   3045:                 }
1.591     raeburn  3046:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3047:                     $locarg = $in{'curr_autharg'};
                   3048:                 }
                   3049:             } else {
                   3050:                 $result = &mt('Currently using local (institutional) authentication.');
                   3051:                 return $result;
1.165     raeburn  3052:             }
                   3053:         }
1.586     raeburn  3054:     } else {
                   3055:         if ($authnum == 1) {
1.784     bisitz   3056:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3057:         }
                   3058:     }
                   3059:     if (!$can_assign{'loc'}) {
                   3060:         return;
1.587     raeburn  3061:     } elsif ($authtype eq '') {
1.591     raeburn  3062:         if (defined($in{'mode'})) {
1.587     raeburn  3063:             if ($in{'mode'} eq 'modifycourse') {
                   3064:                 if ($authnum == 1) {
1.1104    raeburn  3065:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  3066:                 }
                   3067:             }
                   3068:         }
1.165     raeburn  3069:     }
1.586     raeburn  3070:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3071:     if ($authtype eq '') {
                   3072:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3073:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   3074:                     $jscall.'" />';
                   3075:     }
                   3076:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   3077:                $locarg.'" onchange="'.$jscall.'" />';
                   3078:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3079:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3080:     return $result;
                   3081: }
                   3082: 
1.1106    raeburn  3083: sub authform_filesystem {
1.32      matthew  3084:     my %in = (
                   3085:               formname => 'document.cu',
                   3086:               kerb_def_dom => 'MSU.EDU',
                   3087:               @_,
                   3088:               );
1.586     raeburn  3089:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3090:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3091:     if (defined($in{'curr_authtype'})) {
                   3092:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3093:             if ($can_assign{'fsys'}) {
1.772     bisitz   3094:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3095:                 if (defined($in{'mode'})) {
                   3096:                     if ($in{'mode'} eq 'modifyuser') {
                   3097:                         $fsyscheck = '';
                   3098:                     }
                   3099:                 }
1.586     raeburn  3100:             } else {
                   3101:                 $result = &mt('Currently Filesystem Authenticated.');
                   3102:                 return $result;
                   3103:             }           
                   3104:         }
                   3105:     } else {
                   3106:         if ($authnum == 1) {
1.784     bisitz   3107:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3108:         }
                   3109:     }
                   3110:     if (!$can_assign{'fsys'}) {
                   3111:         return;
1.587     raeburn  3112:     } elsif ($authtype eq '') {
1.591     raeburn  3113:         if (defined($in{'mode'})) {
1.587     raeburn  3114:             if ($in{'mode'} eq 'modifycourse') {
                   3115:                 if ($authnum == 1) {
1.1104    raeburn  3116:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  3117:                 }
                   3118:             }
                   3119:         }
1.586     raeburn  3120:     }
                   3121:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3122:     if ($authtype eq '') {
                   3123:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3124:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   3125:                     $jscall.'" />';
                   3126:     }
                   3127:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   3128:                ' onchange="'.$jscall.'" />';
                   3129:     $result = &mt
1.144     matthew  3130:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 3131:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  3132:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   3133:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  3134:                   'onchange="'.$jscall.'" />');
1.32      matthew  3135:     return $result;
                   3136: }
                   3137: 
1.586     raeburn  3138: sub get_assignable_auth {
                   3139:     my ($dom) = @_;
                   3140:     if ($dom eq '') {
                   3141:         $dom = $env{'request.role.domain'};
                   3142:     }
                   3143:     my %can_assign = (
                   3144:                           krb4 => 1,
                   3145:                           krb5 => 1,
                   3146:                           int  => 1,
                   3147:                           loc  => 1,
                   3148:                      );
                   3149:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3150:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3151:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3152:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3153:             my $context;
                   3154:             if ($env{'request.role'} =~ /^au/) {
                   3155:                 $context = 'author';
                   3156:             } elsif ($env{'request.role'} =~ /^dc/) {
                   3157:                 $context = 'domain';
                   3158:             } elsif ($env{'request.course.id'}) {
                   3159:                 $context = 'course';
                   3160:             }
                   3161:             if ($context) {
                   3162:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3163:                    %can_assign = %{$authhash->{$context}}; 
                   3164:                 }
                   3165:             }
                   3166:         }
                   3167:     }
                   3168:     my $authnum = 0;
                   3169:     foreach my $key (keys(%can_assign)) {
                   3170:         if ($can_assign{$key}) {
                   3171:             $authnum ++;
                   3172:         }
                   3173:     }
                   3174:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3175:         $authnum --;
                   3176:     }
                   3177:     return ($authnum,%can_assign);
                   3178: }
                   3179: 
1.80      albertel 3180: ###############################################################
                   3181: ##    Get Kerberos Defaults for Domain                 ##
                   3182: ###############################################################
                   3183: ##
                   3184: ## Returns default kerberos version and an associated argument
                   3185: ## as listed in file domain.tab. If not listed, provides
                   3186: ## appropriate default domain and kerberos version.
                   3187: ##
                   3188: #-------------------------------------------
                   3189: 
                   3190: =pod
                   3191: 
1.648     raeburn  3192: =item * &get_kerberos_defaults()
1.80      albertel 3193: 
                   3194: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3195: version and domain. If not found, it defaults to version 4 and the 
                   3196: domain of the server.
1.80      albertel 3197: 
1.648     raeburn  3198: =over 4
                   3199: 
1.80      albertel 3200: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3201: 
1.648     raeburn  3202: =back
                   3203: 
                   3204: =back
                   3205: 
1.80      albertel 3206: =cut
                   3207: 
                   3208: #-------------------------------------------
                   3209: sub get_kerberos_defaults {
                   3210:     my $domain=shift;
1.641     raeburn  3211:     my ($krbdef,$krbdefdom);
                   3212:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3213:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3214:         $krbdef = $domdefaults{'auth_def'};
                   3215:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3216:     } else {
1.80      albertel 3217:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3218:         my $krbdefdom=$1;
                   3219:         $krbdefdom=~tr/a-z/A-Z/;
                   3220:         $krbdef = "krb4";
                   3221:     }
                   3222:     return ($krbdef,$krbdefdom);
                   3223: }
1.112     bowersj2 3224: 
1.32      matthew  3225: 
1.46      matthew  3226: ###############################################################
                   3227: ##                Thesaurus Functions                        ##
                   3228: ###############################################################
1.20      www      3229: 
1.46      matthew  3230: =pod
1.20      www      3231: 
1.112     bowersj2 3232: =head1 Thesaurus Functions
                   3233: 
                   3234: =over 4
                   3235: 
1.648     raeburn  3236: =item * &initialize_keywords()
1.46      matthew  3237: 
                   3238: Initializes the package variable %Keywords if it is empty.  Uses the
                   3239: package variable $thesaurus_db_file.
                   3240: 
                   3241: =cut
                   3242: 
                   3243: ###################################################
                   3244: 
                   3245: sub initialize_keywords {
                   3246:     return 1 if (scalar keys(%Keywords));
                   3247:     # If we are here, %Keywords is empty, so fill it up
                   3248:     #   Make sure the file we need exists...
                   3249:     if (! -e $thesaurus_db_file) {
                   3250:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3251:                                  " failed because it does not exist");
                   3252:         return 0;
                   3253:     }
                   3254:     #   Set up the hash as a database
                   3255:     my %thesaurus_db;
                   3256:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3257:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3258:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3259:                                  $thesaurus_db_file);
                   3260:         return 0;
                   3261:     } 
                   3262:     #  Get the average number of appearances of a word.
                   3263:     my $avecount = $thesaurus_db{'average.count'};
                   3264:     #  Put keywords (those that appear > average) into %Keywords
                   3265:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3266:         my ($count,undef) = split /:/,$data;
                   3267:         $Keywords{$word}++ if ($count > $avecount);
                   3268:     }
                   3269:     untie %thesaurus_db;
                   3270:     # Remove special values from %Keywords.
1.356     albertel 3271:     foreach my $value ('total.count','average.count') {
                   3272:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3273:   }
1.46      matthew  3274:     return 1;
                   3275: }
                   3276: 
                   3277: ###################################################
                   3278: 
                   3279: =pod
                   3280: 
1.648     raeburn  3281: =item * &keyword($word)
1.46      matthew  3282: 
                   3283: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3284: than the average number of times in the thesaurus database.  Calls 
                   3285: &initialize_keywords
                   3286: 
                   3287: =cut
                   3288: 
                   3289: ###################################################
1.20      www      3290: 
                   3291: sub keyword {
1.46      matthew  3292:     return if (!&initialize_keywords());
                   3293:     my $word=lc(shift());
                   3294:     $word=~s/\W//g;
                   3295:     return exists($Keywords{$word});
1.20      www      3296: }
1.46      matthew  3297: 
                   3298: ###############################################################
                   3299: 
                   3300: =pod 
1.20      www      3301: 
1.648     raeburn  3302: =item * &get_related_words()
1.46      matthew  3303: 
1.160     matthew  3304: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3305: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3306: will be returned.  The order of the words returned is determined by the
                   3307: database which holds them.
                   3308: 
                   3309: Uses global $thesaurus_db_file.
                   3310: 
1.1057    foxr     3311: 
1.46      matthew  3312: =cut
                   3313: 
                   3314: ###############################################################
                   3315: sub get_related_words {
                   3316:     my $keyword = shift;
                   3317:     my %thesaurus_db;
                   3318:     if (! -e $thesaurus_db_file) {
                   3319:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3320:                                  "failed because the file does not exist");
                   3321:         return ();
                   3322:     }
                   3323:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3324:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3325:         return ();
                   3326:     } 
                   3327:     my @Words=();
1.429     www      3328:     my $count=0;
1.46      matthew  3329:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3330: 	# The first element is the number of times
                   3331: 	# the word appears.  We do not need it now.
1.429     www      3332: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3333: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3334: 	my $threshold=$mostfrequentcount/10;
                   3335:         foreach my $possibleword (@RelatedWords) {
                   3336:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3337:             if ($wordcount>$threshold) {
                   3338: 		push(@Words,$word);
                   3339:                 $count++;
                   3340:                 if ($count>10) { last; }
                   3341: 	    }
1.20      www      3342:         }
                   3343:     }
1.46      matthew  3344:     untie %thesaurus_db;
                   3345:     return @Words;
1.14      harris41 3346: }
1.1090    foxr     3347: ###############################################################
                   3348: #
                   3349: #  Spell checking
                   3350: #
                   3351: 
                   3352: =pod
                   3353: 
1.1142    raeburn  3354: =back
                   3355: 
1.1090    foxr     3356: =head1 Spell checking
                   3357: 
                   3358: =over 4
                   3359: 
                   3360: =item * &check_spelling($wordlist $language)
                   3361: 
                   3362: Takes a string containing words and feeds it to an external
                   3363: spellcheck program via a pipeline. Returns a string containing
                   3364: them mis-spelled words.
                   3365: 
                   3366: Parameters:
                   3367: 
                   3368: =over 4
                   3369: 
                   3370: =item - $wordlist
                   3371: 
                   3372: String that will be fed into the spellcheck program.
                   3373: 
                   3374: =item - $language
                   3375: 
                   3376: Language string that specifies the language for which the spell
                   3377: check will be performed.
                   3378: 
                   3379: =back
                   3380: 
                   3381: =back
                   3382: 
                   3383: Note: This sub assumes that aspell is installed.
                   3384: 
                   3385: 
                   3386: =cut
                   3387: 
1.46      matthew  3388: 
1.1090    foxr     3389: sub check_spelling {
                   3390:     my ($wordlist, $language) = @_;
1.1091    foxr     3391:     my @misspellings;
                   3392:     
                   3393:     # Generate the speller and set the langauge.
                   3394:     # if explicitly selected:
1.1090    foxr     3395: 
1.1091    foxr     3396:     my $speller = Text::Aspell->new;
1.1090    foxr     3397:     if ($language) {
1.1091    foxr     3398: 	$speller->set_option('lang', $language);
1.1090    foxr     3399:     }
                   3400: 
1.1091    foxr     3401:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3402: 
1.1091    foxr     3403:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3404: 
1.1091    foxr     3405:     foreach my $word (@words) {
                   3406: 	if(! $speller->check($word)) {
                   3407: 	    push(@misspellings, $word);
1.1090    foxr     3408: 	}
                   3409:     }
1.1091    foxr     3410:     return join(' ', @misspellings);
                   3411:     
1.1090    foxr     3412: }
                   3413: 
1.61      www      3414: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3415: =pod
                   3416: 
1.112     bowersj2 3417: =head1 User Name Functions
                   3418: 
                   3419: =over 4
                   3420: 
1.648     raeburn  3421: =item * &plainname($uname,$udom,$first)
1.81      albertel 3422: 
1.112     bowersj2 3423: Takes a users logon name and returns it as a string in
1.226     albertel 3424: "first middle last generation" form 
                   3425: if $first is set to 'lastname' then it returns it as
                   3426: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3427: 
                   3428: =cut
1.61      www      3429: 
1.295     www      3430: 
1.81      albertel 3431: ###############################################################
1.61      www      3432: sub plainname {
1.226     albertel 3433:     my ($uname,$udom,$first)=@_;
1.537     albertel 3434:     return if (!defined($uname) || !defined($udom));
1.295     www      3435:     my %names=&getnames($uname,$udom);
1.226     albertel 3436:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3437: 					  $names{'middlename'},
                   3438: 					  $names{'lastname'},
                   3439: 					  $names{'generation'},$first);
                   3440:     $name=~s/^\s+//;
1.62      www      3441:     $name=~s/\s+$//;
                   3442:     $name=~s/\s+/ /g;
1.353     albertel 3443:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3444:     return $name;
1.61      www      3445: }
1.66      www      3446: 
                   3447: # -------------------------------------------------------------------- Nickname
1.81      albertel 3448: =pod
                   3449: 
1.648     raeburn  3450: =item * &nickname($uname,$udom)
1.81      albertel 3451: 
                   3452: Gets a users name and returns it as a string as
                   3453: 
                   3454: "&quot;nickname&quot;"
1.66      www      3455: 
1.81      albertel 3456: if the user has a nickname or
                   3457: 
                   3458: "first middle last generation"
                   3459: 
                   3460: if the user does not
                   3461: 
                   3462: =cut
1.66      www      3463: 
                   3464: sub nickname {
                   3465:     my ($uname,$udom)=@_;
1.537     albertel 3466:     return if (!defined($uname) || !defined($udom));
1.295     www      3467:     my %names=&getnames($uname,$udom);
1.68      albertel 3468:     my $name=$names{'nickname'};
1.66      www      3469:     if ($name) {
                   3470:        $name='&quot;'.$name.'&quot;'; 
                   3471:     } else {
                   3472:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3473: 	     $names{'lastname'}.' '.$names{'generation'};
                   3474:        $name=~s/\s+$//;
                   3475:        $name=~s/\s+/ /g;
                   3476:     }
                   3477:     return $name;
                   3478: }
                   3479: 
1.295     www      3480: sub getnames {
                   3481:     my ($uname,$udom)=@_;
1.537     albertel 3482:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3483:     if ($udom eq 'public' && $uname eq 'public') {
                   3484: 	return ('lastname' => &mt('Public'));
                   3485:     }
1.295     www      3486:     my $id=$uname.':'.$udom;
                   3487:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3488:     if ($cached) {
                   3489: 	return %{$names};
                   3490:     } else {
                   3491: 	my %loadnames=&Apache::lonnet::get('environment',
                   3492:                     ['firstname','middlename','lastname','generation','nickname'],
                   3493: 					 $udom,$uname);
                   3494: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3495: 	return %loadnames;
                   3496:     }
                   3497: }
1.61      www      3498: 
1.542     raeburn  3499: # -------------------------------------------------------------------- getemails
1.648     raeburn  3500: 
1.542     raeburn  3501: =pod
                   3502: 
1.648     raeburn  3503: =item * &getemails($uname,$udom)
1.542     raeburn  3504: 
                   3505: Gets a user's email information and returns it as a hash with keys:
                   3506: notification, critnotification, permanentemail
                   3507: 
                   3508: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3509: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3510:  
1.648     raeburn  3511: 
1.542     raeburn  3512: =cut
                   3513: 
1.648     raeburn  3514: 
1.466     albertel 3515: sub getemails {
                   3516:     my ($uname,$udom)=@_;
                   3517:     if ($udom eq 'public' && $uname eq 'public') {
                   3518: 	return;
                   3519:     }
1.467     www      3520:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3521:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3522:     my $id=$uname.':'.$udom;
                   3523:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3524:     if ($cached) {
                   3525: 	return %{$names};
                   3526:     } else {
                   3527: 	my %loadnames=&Apache::lonnet::get('environment',
                   3528:                     			   ['notification','critnotification',
                   3529: 					    'permanentemail'],
                   3530: 					   $udom,$uname);
                   3531: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3532: 	return %loadnames;
                   3533:     }
                   3534: }
                   3535: 
1.551     albertel 3536: sub flush_email_cache {
                   3537:     my ($uname,$udom)=@_;
                   3538:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3539:     if (!$uname) { $uname=$env{'user.name'};   }
                   3540:     return if ($udom eq 'public' && $uname eq 'public');
                   3541:     my $id=$uname.':'.$udom;
                   3542:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3543: }
                   3544: 
1.728     raeburn  3545: # -------------------------------------------------------------------- getlangs
                   3546: 
                   3547: =pod
                   3548: 
                   3549: =item * &getlangs($uname,$udom)
                   3550: 
                   3551: Gets a user's language preference and returns it as a hash with key:
                   3552: language.
                   3553: 
                   3554: =cut
                   3555: 
                   3556: 
                   3557: sub getlangs {
                   3558:     my ($uname,$udom) = @_;
                   3559:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3560:     if (!$uname) { $uname=$env{'user.name'};   }
                   3561:     my $id=$uname.':'.$udom;
                   3562:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3563:     if ($cached) {
                   3564:         return %{$langs};
                   3565:     } else {
                   3566:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3567:                                            $udom,$uname);
                   3568:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3569:         return %loadlangs;
                   3570:     }
                   3571: }
                   3572: 
                   3573: sub flush_langs_cache {
                   3574:     my ($uname,$udom)=@_;
                   3575:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3576:     if (!$uname) { $uname=$env{'user.name'};   }
                   3577:     return if ($udom eq 'public' && $uname eq 'public');
                   3578:     my $id=$uname.':'.$udom;
                   3579:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3580: }
                   3581: 
1.61      www      3582: # ------------------------------------------------------------------ Screenname
1.81      albertel 3583: 
                   3584: =pod
                   3585: 
1.648     raeburn  3586: =item * &screenname($uname,$udom)
1.81      albertel 3587: 
                   3588: Gets a users screenname and returns it as a string
                   3589: 
                   3590: =cut
1.61      www      3591: 
                   3592: sub screenname {
                   3593:     my ($uname,$udom)=@_;
1.258     albertel 3594:     if ($uname eq $env{'user.name'} &&
                   3595: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3596:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3597:     return $names{'screenname'};
1.62      www      3598: }
                   3599: 
1.212     albertel 3600: 
1.802     bisitz   3601: # ------------------------------------------------------------- Confirm Wrapper
                   3602: =pod
                   3603: 
1.1142    raeburn  3604: =item * &confirmwrapper($message)
1.802     bisitz   3605: 
                   3606: Wrap messages about completion of operation in box
                   3607: 
                   3608: =cut
                   3609: 
                   3610: sub confirmwrapper {
                   3611:     my ($message)=@_;
                   3612:     if ($message) {
                   3613:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3614:                .$message."\n"
                   3615:                .'</div>'."\n";
                   3616:     } else {
                   3617:         return $message;
                   3618:     }
                   3619: }
                   3620: 
1.62      www      3621: # ------------------------------------------------------------- Message Wrapper
                   3622: 
                   3623: sub messagewrapper {
1.369     www      3624:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3625:     return 
1.441     albertel 3626:         '<a href="/adm/email?compose=individual&amp;'.
                   3627:         'recname='.$username.'&amp;recdom='.$domain.
                   3628: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3629:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3630: }
1.802     bisitz   3631: 
1.74      www      3632: # --------------------------------------------------------------- Notes Wrapper
                   3633: 
                   3634: sub noteswrapper {
                   3635:     my ($link,$un,$do)=@_;
                   3636:     return 
1.896     amueller 3637: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3638: }
1.802     bisitz   3639: 
1.62      www      3640: # ------------------------------------------------------------- Aboutme Wrapper
                   3641: 
                   3642: sub aboutmewrapper {
1.1070    raeburn  3643:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3644:     if (!defined($username)  && !defined($domain)) {
                   3645:         return;
                   3646:     }
1.1096    raeburn  3647:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3648: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3649: }
                   3650: 
                   3651: # ------------------------------------------------------------ Syllabus Wrapper
                   3652: 
                   3653: sub syllabuswrapper {
1.707     bisitz   3654:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3655:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3656: }
1.14      harris41 3657: 
1.802     bisitz   3658: # -----------------------------------------------------------------------------
                   3659: 
1.208     matthew  3660: sub track_student_link {
1.887     raeburn  3661:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3662:     my $link ="/adm/trackstudent?";
1.208     matthew  3663:     my $title = 'View recent activity';
                   3664:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3665:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3666:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3667:         $title .= ' of this student';
1.268     albertel 3668:     } 
1.208     matthew  3669:     if (defined($target) && $target !~ /^\s*$/) {
                   3670:         $target = qq{target="$target"};
                   3671:     } else {
                   3672:         $target = '';
                   3673:     }
1.268     albertel 3674:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3675:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3676:     $title = &mt($title);
                   3677:     $linktext = &mt($linktext);
1.448     albertel 3678:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3679: 	&help_open_topic('View_recent_activity');
1.208     matthew  3680: }
                   3681: 
1.781     raeburn  3682: sub slot_reservations_link {
                   3683:     my ($linktext,$sname,$sdom,$target) = @_;
                   3684:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3685:     my $title = 'View slot reservation history';
                   3686:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3687:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3688:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3689:         $title .= ' of this student';
                   3690:     }
                   3691:     if (defined($target) && $target !~ /^\s*$/) {
                   3692:         $target = qq{target="$target"};
                   3693:     } else {
                   3694:         $target = '';
                   3695:     }
                   3696:     $title = &mt($title);
                   3697:     $linktext = &mt($linktext);
                   3698:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3699: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3700: 
                   3701: }
                   3702: 
1.508     www      3703: # ===================================================== Display a student photo
                   3704: 
                   3705: 
1.509     albertel 3706: sub student_image_tag {
1.508     www      3707:     my ($domain,$user)=@_;
                   3708:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3709:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3710: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3711:     } else {
                   3712: 	return '';
                   3713:     }
                   3714: }
                   3715: 
1.112     bowersj2 3716: =pod
                   3717: 
                   3718: =back
                   3719: 
                   3720: =head1 Access .tab File Data
                   3721: 
                   3722: =over 4
                   3723: 
1.648     raeburn  3724: =item * &languageids() 
1.112     bowersj2 3725: 
                   3726: returns list of all language ids
                   3727: 
                   3728: =cut
                   3729: 
1.14      harris41 3730: sub languageids {
1.16      harris41 3731:     return sort(keys(%language));
1.14      harris41 3732: }
                   3733: 
1.112     bowersj2 3734: =pod
                   3735: 
1.648     raeburn  3736: =item * &languagedescription() 
1.112     bowersj2 3737: 
                   3738: returns description of a specified language id
                   3739: 
                   3740: =cut
                   3741: 
1.14      harris41 3742: sub languagedescription {
1.125     www      3743:     my $code=shift;
                   3744:     return  ($supported_language{$code}?'* ':'').
                   3745:             $language{$code}.
1.126     www      3746: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3747: }
                   3748: 
1.1048    foxr     3749: =pod
                   3750: 
                   3751: =item * &plainlanguagedescription
                   3752: 
                   3753: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3754: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3755: 
                   3756: =cut
                   3757: 
1.145     www      3758: sub plainlanguagedescription {
                   3759:     my $code=shift;
                   3760:     return $language{$code};
                   3761: }
                   3762: 
1.1048    foxr     3763: =pod
                   3764: 
                   3765: =item * &supportedlanguagecode
                   3766: 
                   3767: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3768: code.
                   3769: 
                   3770: =cut
                   3771: 
1.145     www      3772: sub supportedlanguagecode {
                   3773:     my $code=shift;
                   3774:     return $supported_language{$code};
1.97      www      3775: }
                   3776: 
1.112     bowersj2 3777: =pod
                   3778: 
1.1048    foxr     3779: =item * &latexlanguage()
                   3780: 
                   3781: Given a language key code returns the correspondnig language to use
                   3782: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3783: is no supported hyphenation for the language code.
                   3784: 
                   3785: =cut
                   3786: 
                   3787: sub latexlanguage {
                   3788:     my $code = shift;
                   3789:     return $latex_language{$code};
                   3790: }
                   3791: 
                   3792: =pod
                   3793: 
                   3794: =item * &latexhyphenation()
                   3795: 
                   3796: Same as above but what's supplied is the language as it might be stored
                   3797: in the metadata.
                   3798: 
                   3799: =cut
                   3800: 
                   3801: sub latexhyphenation {
                   3802:     my $key = shift;
                   3803:     return $latex_language_bykey{$key};
                   3804: }
                   3805: 
                   3806: =pod
                   3807: 
1.648     raeburn  3808: =item * &copyrightids() 
1.112     bowersj2 3809: 
                   3810: returns list of all copyrights
                   3811: 
                   3812: =cut
                   3813: 
                   3814: sub copyrightids {
                   3815:     return sort(keys(%cprtag));
                   3816: }
                   3817: 
                   3818: =pod
                   3819: 
1.648     raeburn  3820: =item * &copyrightdescription() 
1.112     bowersj2 3821: 
                   3822: returns description of a specified copyright id
                   3823: 
                   3824: =cut
                   3825: 
                   3826: sub copyrightdescription {
1.166     www      3827:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3828: }
1.197     matthew  3829: 
                   3830: =pod
                   3831: 
1.648     raeburn  3832: =item * &source_copyrightids() 
1.192     taceyjo1 3833: 
                   3834: returns list of all source copyrights
                   3835: 
                   3836: =cut
                   3837: 
                   3838: sub source_copyrightids {
                   3839:     return sort(keys(%scprtag));
                   3840: }
                   3841: 
                   3842: =pod
                   3843: 
1.648     raeburn  3844: =item * &source_copyrightdescription() 
1.192     taceyjo1 3845: 
                   3846: returns description of a specified source copyright id
                   3847: 
                   3848: =cut
                   3849: 
                   3850: sub source_copyrightdescription {
                   3851:     return &mt($scprtag{shift(@_)});
                   3852: }
1.112     bowersj2 3853: 
                   3854: =pod
                   3855: 
1.648     raeburn  3856: =item * &filecategories() 
1.112     bowersj2 3857: 
                   3858: returns list of all file categories
                   3859: 
                   3860: =cut
                   3861: 
                   3862: sub filecategories {
                   3863:     return sort(keys(%category_extensions));
                   3864: }
                   3865: 
                   3866: =pod
                   3867: 
1.648     raeburn  3868: =item * &filecategorytypes() 
1.112     bowersj2 3869: 
                   3870: returns list of file types belonging to a given file
                   3871: category
                   3872: 
                   3873: =cut
                   3874: 
                   3875: sub filecategorytypes {
1.356     albertel 3876:     my ($cat) = @_;
                   3877:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3878: }
                   3879: 
                   3880: =pod
                   3881: 
1.648     raeburn  3882: =item * &fileembstyle() 
1.112     bowersj2 3883: 
                   3884: returns embedding style for a specified file type
                   3885: 
                   3886: =cut
                   3887: 
                   3888: sub fileembstyle {
                   3889:     return $fe{lc(shift(@_))};
1.169     www      3890: }
                   3891: 
1.351     www      3892: sub filemimetype {
                   3893:     return $fm{lc(shift(@_))};
                   3894: }
                   3895: 
1.169     www      3896: 
                   3897: sub filecategoryselect {
                   3898:     my ($name,$value)=@_;
1.189     matthew  3899:     return &select_form($value,$name,
1.970     raeburn  3900:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3901: }
                   3902: 
                   3903: =pod
                   3904: 
1.648     raeburn  3905: =item * &filedescription() 
1.112     bowersj2 3906: 
                   3907: returns description for a specified file type
                   3908: 
                   3909: =cut
                   3910: 
                   3911: sub filedescription {
1.188     matthew  3912:     my $file_description = $fd{lc(shift())};
                   3913:     $file_description =~ s:([\[\]]):~$1:g;
                   3914:     return &mt($file_description);
1.112     bowersj2 3915: }
                   3916: 
                   3917: =pod
                   3918: 
1.648     raeburn  3919: =item * &filedescriptionex() 
1.112     bowersj2 3920: 
                   3921: returns description for a specified file type with
                   3922: extra formatting
                   3923: 
                   3924: =cut
                   3925: 
                   3926: sub filedescriptionex {
                   3927:     my $ex=shift;
1.188     matthew  3928:     my $file_description = $fd{lc($ex)};
                   3929:     $file_description =~ s:([\[\]]):~$1:g;
                   3930:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3931: }
                   3932: 
                   3933: # End of .tab access
                   3934: =pod
                   3935: 
                   3936: =back
                   3937: 
                   3938: =cut
                   3939: 
                   3940: # ------------------------------------------------------------------ File Types
                   3941: sub fileextensions {
                   3942:     return sort(keys(%fe));
                   3943: }
                   3944: 
1.97      www      3945: # ----------------------------------------------------------- Display Languages
                   3946: # returns a hash with all desired display languages
                   3947: #
                   3948: 
                   3949: sub display_languages {
                   3950:     my %languages=();
1.695     raeburn  3951:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3952: 	$languages{$lang}=1;
1.97      www      3953:     }
                   3954:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3955:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3956: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3957: 	    $languages{$lang}=1;
1.97      www      3958:         }
                   3959:     }
                   3960:     return %languages;
1.14      harris41 3961: }
                   3962: 
1.582     albertel 3963: sub languages {
                   3964:     my ($possible_langs) = @_;
1.695     raeburn  3965:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3966:     if (!ref($possible_langs)) {
                   3967: 	if( wantarray ) {
                   3968: 	    return @preferred_langs;
                   3969: 	} else {
                   3970: 	    return $preferred_langs[0];
                   3971: 	}
                   3972:     }
                   3973:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3974:     my @preferred_possibilities;
                   3975:     foreach my $preferred_lang (@preferred_langs) {
                   3976: 	if (exists($possibilities{$preferred_lang})) {
                   3977: 	    push(@preferred_possibilities, $preferred_lang);
                   3978: 	}
                   3979:     }
                   3980:     if( wantarray ) {
                   3981: 	return @preferred_possibilities;
                   3982:     }
                   3983:     return $preferred_possibilities[0];
                   3984: }
                   3985: 
1.742     raeburn  3986: sub user_lang {
                   3987:     my ($touname,$toudom,$fromcid) = @_;
                   3988:     my @userlangs;
                   3989:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3990:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3991:                     $env{'course.'.$fromcid.'.languages'}));
                   3992:     } else {
                   3993:         my %langhash = &getlangs($touname,$toudom);
                   3994:         if ($langhash{'languages'} ne '') {
                   3995:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3996:         } else {
                   3997:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3998:             if ($domdefs{'lang_def'} ne '') {
                   3999:                 @userlangs = ($domdefs{'lang_def'});
                   4000:             }
                   4001:         }
                   4002:     }
                   4003:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4004:     my $user_lh = Apache::localize->get_handle(@languages);
                   4005:     return $user_lh;
                   4006: }
                   4007: 
                   4008: 
1.112     bowersj2 4009: ###############################################################
                   4010: ##               Student Answer Attempts                     ##
                   4011: ###############################################################
                   4012: 
                   4013: =pod
                   4014: 
                   4015: =head1 Alternate Problem Views
                   4016: 
                   4017: =over 4
                   4018: 
1.648     raeburn  4019: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199    raeburn  4020:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4021: 
                   4022: Return string with previous attempt on problem. Arguments:
                   4023: 
                   4024: =over 4
                   4025: 
                   4026: =item * $symb: Problem, including path
                   4027: 
                   4028: =item * $username: username of the desired student
                   4029: 
                   4030: =item * $domain: domain of the desired student
1.14      harris41 4031: 
1.112     bowersj2 4032: =item * $course: Course ID
1.14      harris41 4033: 
1.112     bowersj2 4034: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4035:     something
1.14      harris41 4036: 
1.112     bowersj2 4037: =item * $regexp: if string matches this regexp, the string will be
                   4038:     sent to $gradesub
1.14      harris41 4039: 
1.112     bowersj2 4040: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4041: 
1.1199    raeburn  4042: =item * $usec: section of the desired student
                   4043: 
                   4044: =item * $identifier: counter for student (multiple students one problem) or 
                   4045:     problem (one student; whole sequence).
                   4046: 
1.112     bowersj2 4047: =back
1.14      harris41 4048: 
1.112     bowersj2 4049: The output string is a table containing all desired attempts, if any.
1.16      harris41 4050: 
1.112     bowersj2 4051: =cut
1.1       albertel 4052: 
                   4053: sub get_previous_attempt {
1.1199    raeburn  4054:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4055:   my $prevattempts='';
1.43      ng       4056:   no strict 'refs';
1.1       albertel 4057:   if ($symb) {
1.3       albertel 4058:     my (%returnhash)=
                   4059:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4060:     if ($returnhash{'version'}) {
                   4061:       my %lasthash=();
                   4062:       my $version;
                   4063:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212    raeburn  4064:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4065:             if ($key =~ /\.rawrndseed$/) {
                   4066:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4067:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4068:             } else {
                   4069:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4070:             }
1.19      harris41 4071:         }
1.1       albertel 4072:       }
1.596     albertel 4073:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4074:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1199    raeburn  4075:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4076:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4077:       foreach my $key (sort(keys(%lasthash))) {
                   4078: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4079: 	if ($#parts > 0) {
1.31      albertel 4080: 	  my $data=$parts[-1];
1.989     raeburn  4081:           next if ($data eq 'foilorder');
1.31      albertel 4082: 	  pop(@parts);
1.1010    www      4083:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4084:           if ($data eq 'type') {
                   4085:               unless ($showsurv) {
                   4086:                   my $id = join(',',@parts);
                   4087:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4088:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4089:                       $lasthidden{$ign.'.'.$id} = 1;
                   4090:                   }
1.945     raeburn  4091:               }
1.1199    raeburn  4092:               if ($identifier ne '') {
                   4093:                   my $id = join(',',@parts);
                   4094:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4095:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4096:                       $hidestatus{$ign.'.'.$id} = 1;
                   4097:                   }
                   4098:               }
                   4099:           } elsif ($data eq 'regrader') {
                   4100:               if (($identifier ne '') && (@parts)) {
1.1200    raeburn  4101:                   my $id = join(',',@parts);
                   4102:                   $regraded{$ign.'.'.$id} = 1;
1.1199    raeburn  4103:               }
1.1010    www      4104:           } 
1.31      albertel 4105: 	} else {
1.41      ng       4106: 	  if ($#parts == 0) {
                   4107: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4108: 	  } else {
                   4109: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4110: 	  }
1.31      albertel 4111: 	}
1.16      harris41 4112:       }
1.596     albertel 4113:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4114:       if ($getattempt eq '') {
1.1199    raeburn  4115:         my (%solved,%resets,%probstatus);
1.1200    raeburn  4116:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4117:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4118:                 foreach my $id (keys(%regraded)) {
                   4119:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4120:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4121:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4122:                         push(@{$resets{$id}},$version);
1.1199    raeburn  4123:                     }
                   4124:                 }
                   4125:             }
1.1200    raeburn  4126:         }
                   4127: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199    raeburn  4128:             my (@hidden,@unsolved);
1.945     raeburn  4129:             if (%typeparts) {
                   4130:                 foreach my $id (keys(%typeparts)) {
1.1199    raeburn  4131:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                   4132:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4133:                         push(@hidden,$id);
1.1199    raeburn  4134:                     } elsif ($identifier ne '') {
                   4135:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4136:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4137:                                 ($hidestatus{$id})) {
1.1200    raeburn  4138:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199    raeburn  4139:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4140:                                 push(@{$solved{$id}},$version);
                   4141:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4142:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4143:                                 my $skip;
                   4144:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4145:                                     foreach my $reset (@{$resets{$id}}) {
                   4146:                                         if ($reset > $solved{$id}[-1]) {
                   4147:                                             $skip=1;
                   4148:                                             last;
                   4149:                                         }
                   4150:                                     }
                   4151:                                 }
                   4152:                                 unless ($skip) {
                   4153:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4154:                                     push(@unsolved,$partslist);
                   4155:                                 }
                   4156:                             }
                   4157:                         }
1.945     raeburn  4158:                     }
                   4159:                 }
                   4160:             }
                   4161:             $prevattempts.=&start_data_table_row().
1.1199    raeburn  4162:                            '<td>'.&mt('Transaction [_1]',$version);
                   4163:             if (@unsolved) {
                   4164:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4165:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4166:                                  &mt('Hide').'</label></span>';
                   4167:             }
                   4168:             $prevattempts .= '</td>';
1.945     raeburn  4169:             if (@hidden) {
                   4170:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4171:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4172:                     my $hide;
                   4173:                     foreach my $id (@hidden) {
                   4174:                         if ($key =~ /^\Q$id\E/) {
                   4175:                             $hide = 1;
                   4176:                             last;
                   4177:                         }
                   4178:                     }
                   4179:                     if ($hide) {
                   4180:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4181:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4182:                             my $value = &format_previous_attempt_value($key,
                   4183:                                              $returnhash{$version.':'.$key});
1.1173    kruse    4184:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4185:                         } else {
                   4186:                             $prevattempts.='<td>&nbsp;</td>';
                   4187:                         }
                   4188:                     } else {
                   4189:                         if ($key =~ /\./) {
1.1212    raeburn  4190:                             my $value = $returnhash{$version.':'.$key};
                   4191:                             if ($key =~ /\.rndseed$/) {
                   4192:                                 my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4193:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4194:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4195:                                 }
                   4196:                             }
                   4197:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4198:                                            '&nbsp;</td>';
1.945     raeburn  4199:                         } else {
                   4200:                             $prevattempts.='<td>&nbsp;</td>';
                   4201:                         }
                   4202:                     }
                   4203:                 }
                   4204:             } else {
                   4205: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4206:                     next if ($key =~ /\.foilorder$/);
1.1212    raeburn  4207:                     my $value = $returnhash{$version.':'.$key};
                   4208:                     if ($key =~ /\.rndseed$/) {
                   4209:                         my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4210:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4211:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4212:                         }
                   4213:                     }
                   4214:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4215:                                    '&nbsp;</td>';
1.945     raeburn  4216: 	        }
                   4217:             }
                   4218: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4219: 	 }
1.1       albertel 4220:       }
1.945     raeburn  4221:       my @currhidden = keys(%lasthidden);
1.596     albertel 4222:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4223:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4224:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4225:           if (%typeparts) {
                   4226:               my $hidden;
                   4227:               foreach my $id (@currhidden) {
                   4228:                   if ($key =~ /^\Q$id\E/) {
                   4229:                       $hidden = 1;
                   4230:                       last;
                   4231:                   }
                   4232:               }
                   4233:               if ($hidden) {
                   4234:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4235:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4236:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4237:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4238:                           $value = &$gradesub($value);
                   4239:                       }
1.1173    kruse    4240:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  4241:                   } else {
                   4242:                       $prevattempts.='<td>&nbsp;</td>';
                   4243:                   }
                   4244:               } else {
                   4245:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4246:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4247:                       $value = &$gradesub($value);
                   4248:                   }
1.1173    kruse    4249:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4250:               }
                   4251:           } else {
                   4252: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4253: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4254:                   $value = &$gradesub($value);
                   4255:               }
1.1173    kruse    4256: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4257:           }
1.16      harris41 4258:       }
1.596     albertel 4259:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4260:     } else {
1.596     albertel 4261:       $prevattempts=
                   4262: 	  &start_data_table().&start_data_table_row().
                   4263: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   4264: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4265:     }
                   4266:   } else {
1.596     albertel 4267:     $prevattempts=
                   4268: 	  &start_data_table().&start_data_table_row().
                   4269: 	  '<td>'.&mt('No data.').'</td>'.
                   4270: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4271:   }
1.10      albertel 4272: }
                   4273: 
1.581     albertel 4274: sub format_previous_attempt_value {
                   4275:     my ($key,$value) = @_;
1.1011    www      4276:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    4277:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 4278:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    4279:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  4280:     } elsif ($key =~ /answerstring$/) {
                   4281:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    4282:         my @answer = %answers;
                   4283:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  4284:         my @anskeys = sort(keys(%answers));
                   4285:         if (@anskeys == 1) {
                   4286:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4287:             if ($answer =~ m{\0}) {
                   4288:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4289:             }
                   4290:             my $tag_internal_answer_name = 'INTERNAL';
                   4291:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4292:                 $value = $answer; 
                   4293:             } else {
                   4294:                 $value = $anskeys[0].'='.$answer;
                   4295:             }
                   4296:         } else {
                   4297:             foreach my $ans (@anskeys) {
                   4298:                 my $answer = $answers{$ans};
1.1001    raeburn  4299:                 if ($answer =~ m{\0}) {
                   4300:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4301:                 }
                   4302:                 $value .=  $ans.'='.$answer.'<br />';;
                   4303:             } 
                   4304:         }
1.581     albertel 4305:     } else {
1.1173    kruse    4306:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 4307:     }
                   4308:     return $value;
                   4309: }
                   4310: 
                   4311: 
1.107     albertel 4312: sub relative_to_absolute {
                   4313:     my ($url,$output)=@_;
                   4314:     my $parser=HTML::TokeParser->new(\$output);
                   4315:     my $token;
                   4316:     my $thisdir=$url;
                   4317:     my @rlinks=();
                   4318:     while ($token=$parser->get_token) {
                   4319: 	if ($token->[0] eq 'S') {
                   4320: 	    if ($token->[1] eq 'a') {
                   4321: 		if ($token->[2]->{'href'}) {
                   4322: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4323: 		}
                   4324: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4325: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4326: 	    } elsif ($token->[1] eq 'base') {
                   4327: 		$thisdir=$token->[2]->{'href'};
                   4328: 	    }
                   4329: 	}
                   4330:     }
                   4331:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4332:     foreach my $link (@rlinks) {
1.726     raeburn  4333: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4334: 		($link=~/^\//) ||
                   4335: 		($link=~/^javascript:/i) ||
                   4336: 		($link=~/^mailto:/i) ||
                   4337: 		($link=~/^\#/)) {
                   4338: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4339: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4340: 	}
                   4341:     }
                   4342: # -------------------------------------------------- Deal with Applet codebases
                   4343:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4344:     return $output;
                   4345: }
                   4346: 
1.112     bowersj2 4347: =pod
                   4348: 
1.648     raeburn  4349: =item * &get_student_view()
1.112     bowersj2 4350: 
                   4351: show a snapshot of what student was looking at
                   4352: 
                   4353: =cut
                   4354: 
1.10      albertel 4355: sub get_student_view {
1.186     albertel 4356:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4357:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4358:   my (%form);
1.10      albertel 4359:   my @elements=('symb','courseid','domain','username');
                   4360:   foreach my $element (@elements) {
1.186     albertel 4361:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4362:   }
1.186     albertel 4363:   if (defined($moreenv)) {
                   4364:       %form=(%form,%{$moreenv});
                   4365:   }
1.236     albertel 4366:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4367:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4368:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4369:   $userview=~s/\<body[^\>]*\>//gi;
                   4370:   $userview=~s/\<\/body\>//gi;
                   4371:   $userview=~s/\<html\>//gi;
                   4372:   $userview=~s/\<\/html\>//gi;
                   4373:   $userview=~s/\<head\>//gi;
                   4374:   $userview=~s/\<\/head\>//gi;
                   4375:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4376:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4377:   if (wantarray) {
                   4378:      return ($userview,$response);
                   4379:   } else {
                   4380:      return $userview;
                   4381:   }
                   4382: }
                   4383: 
                   4384: sub get_student_view_with_retries {
                   4385:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4386: 
                   4387:     my $ok = 0;                 # True if we got a good response.
                   4388:     my $content;
                   4389:     my $response;
                   4390: 
                   4391:     # Try to get the student_view done. within the retries count:
                   4392:     
                   4393:     do {
                   4394:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4395:          $ok      = $response->is_success;
                   4396:          if (!$ok) {
                   4397:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4398:          }
                   4399:          $retries--;
                   4400:     } while (!$ok && ($retries > 0));
                   4401:     
                   4402:     if (!$ok) {
                   4403:        $content = '';          # On error return an empty content.
                   4404:     }
1.651     www      4405:     if (wantarray) {
                   4406:        return ($content, $response);
                   4407:     } else {
                   4408:        return $content;
                   4409:     }
1.11      albertel 4410: }
                   4411: 
1.112     bowersj2 4412: =pod
                   4413: 
1.648     raeburn  4414: =item * &get_student_answers() 
1.112     bowersj2 4415: 
                   4416: show a snapshot of how student was answering problem
                   4417: 
                   4418: =cut
                   4419: 
1.11      albertel 4420: sub get_student_answers {
1.100     sakharuk 4421:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4422:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4423:   my (%moreenv);
1.11      albertel 4424:   my @elements=('symb','courseid','domain','username');
                   4425:   foreach my $element (@elements) {
1.186     albertel 4426:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4427:   }
1.186     albertel 4428:   $moreenv{'grade_target'}='answer';
                   4429:   %moreenv=(%form,%moreenv);
1.497     raeburn  4430:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4431:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4432:   return $userview;
1.1       albertel 4433: }
1.116     albertel 4434: 
                   4435: =pod
                   4436: 
                   4437: =item * &submlink()
                   4438: 
1.242     albertel 4439: Inputs: $text $uname $udom $symb $target
1.116     albertel 4440: 
                   4441: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4442: 
                   4443: =cut
                   4444: 
                   4445: ###############################################
                   4446: sub submlink {
1.242     albertel 4447:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4448:     if (!($uname && $udom)) {
                   4449: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4450: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4451: 	if (!$symb) { $symb=$cursymb; }
                   4452:     }
1.254     matthew  4453:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4454:     $symb=&escape($symb);
1.960     bisitz   4455:     if ($target) { $target=" target=\"$target\""; }
                   4456:     return
                   4457:         '<a href="/adm/grades?command=submission'.
                   4458:         '&amp;symb='.$symb.
                   4459:         '&amp;student='.$uname.
                   4460:         '&amp;userdom='.$udom.'"'.
                   4461:         $target.'>'.$text.'</a>';
1.242     albertel 4462: }
                   4463: ##############################################
                   4464: 
                   4465: =pod
                   4466: 
                   4467: =item * &pgrdlink()
                   4468: 
                   4469: Inputs: $text $uname $udom $symb $target
                   4470: 
                   4471: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4472: 
                   4473: =cut
                   4474: 
                   4475: ###############################################
                   4476: sub pgrdlink {
                   4477:     my $link=&submlink(@_);
                   4478:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4479:     return $link;
                   4480: }
                   4481: ##############################################
                   4482: 
                   4483: =pod
                   4484: 
                   4485: =item * &pprmlink()
                   4486: 
                   4487: Inputs: $text $uname $udom $symb $target
                   4488: 
                   4489: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4490: student and a specific resource
1.242     albertel 4491: 
                   4492: =cut
                   4493: 
                   4494: ###############################################
                   4495: sub pprmlink {
                   4496:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4497:     if (!($uname && $udom)) {
                   4498: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4499: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4500: 	if (!$symb) { $symb=$cursymb; }
                   4501:     }
1.254     matthew  4502:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4503:     $symb=&escape($symb);
1.242     albertel 4504:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4505:     return '<a href="/adm/parmset?command=set&amp;'.
                   4506: 	'symb='.$symb.'&amp;uname='.$uname.
                   4507: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4508: }
                   4509: ##############################################
1.37      matthew  4510: 
1.112     bowersj2 4511: =pod
                   4512: 
                   4513: =back
                   4514: 
                   4515: =cut
                   4516: 
1.37      matthew  4517: ###############################################
1.51      www      4518: 
                   4519: 
                   4520: sub timehash {
1.687     raeburn  4521:     my ($thistime) = @_;
                   4522:     my $timezone = &Apache::lonlocal::gettimezone();
                   4523:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4524:                      ->set_time_zone($timezone);
                   4525:     my $wday = $dt->day_of_week();
                   4526:     if ($wday == 7) { $wday = 0; }
                   4527:     return ( 'second' => $dt->second(),
                   4528:              'minute' => $dt->minute(),
                   4529:              'hour'   => $dt->hour(),
                   4530:              'day'     => $dt->day_of_month(),
                   4531:              'month'   => $dt->month(),
                   4532:              'year'    => $dt->year(),
                   4533:              'weekday' => $wday,
                   4534:              'dayyear' => $dt->day_of_year(),
                   4535:              'dlsav'   => $dt->is_dst() );
1.51      www      4536: }
                   4537: 
1.370     www      4538: sub utc_string {
                   4539:     my ($date)=@_;
1.371     www      4540:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4541: }
                   4542: 
1.51      www      4543: sub maketime {
                   4544:     my %th=@_;
1.687     raeburn  4545:     my ($epoch_time,$timezone,$dt);
                   4546:     $timezone = &Apache::lonlocal::gettimezone();
                   4547:     eval {
                   4548:         $dt = DateTime->new( year   => $th{'year'},
                   4549:                              month  => $th{'month'},
                   4550:                              day    => $th{'day'},
                   4551:                              hour   => $th{'hour'},
                   4552:                              minute => $th{'minute'},
                   4553:                              second => $th{'second'},
                   4554:                              time_zone => $timezone,
                   4555:                          );
                   4556:     };
                   4557:     if (!$@) {
                   4558:         $epoch_time = $dt->epoch;
                   4559:         if ($epoch_time) {
                   4560:             return $epoch_time;
                   4561:         }
                   4562:     }
1.51      www      4563:     return POSIX::mktime(
                   4564:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4565:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4566: }
                   4567: 
                   4568: #########################################
1.51      www      4569: 
                   4570: sub findallcourses {
1.482     raeburn  4571:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4572:     my %roles;
                   4573:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4574:     my %courses;
1.51      www      4575:     my $now=time;
1.482     raeburn  4576:     if (!defined($uname)) {
                   4577:         $uname = $env{'user.name'};
                   4578:     }
                   4579:     if (!defined($udom)) {
                   4580:         $udom = $env{'user.domain'};
                   4581:     }
                   4582:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4583:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4584:         if (!%roles) {
                   4585:             %roles = (
                   4586:                        cc => 1,
1.907     raeburn  4587:                        co => 1,
1.482     raeburn  4588:                        in => 1,
                   4589:                        ep => 1,
                   4590:                        ta => 1,
                   4591:                        cr => 1,
                   4592:                        st => 1,
                   4593:              );
                   4594:         }
                   4595:         foreach my $entry (keys(%roleshash)) {
                   4596:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4597:             if ($trole =~ /^cr/) { 
                   4598:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4599:             } else {
                   4600:                 next if (!exists($roles{$trole}));
                   4601:             }
                   4602:             if ($tend) {
                   4603:                 next if ($tend < $now);
                   4604:             }
                   4605:             if ($tstart) {
                   4606:                 next if ($tstart > $now);
                   4607:             }
1.1058    raeburn  4608:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4609:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4610:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4611:             if ($secpart eq '') {
                   4612:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4613:                 $sec = 'none';
1.1058    raeburn  4614:                 $value .= $cnum.'/';
1.482     raeburn  4615:             } else {
                   4616:                 $cnum = $cnumpart;
                   4617:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4618:                 $value .= $cnum.'/'.$sec;
                   4619:             }
                   4620:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4621:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4622:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4623:                 }
                   4624:             } else {
                   4625:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4626:             }
1.482     raeburn  4627:         }
                   4628:     } else {
                   4629:         foreach my $key (keys(%env)) {
1.483     albertel 4630: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4631:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4632: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4633: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4634: 	        next if (%roles && !exists($roles{$role}));
                   4635: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4636:                 my $active=1;
                   4637:                 if ($starttime) {
                   4638: 		    if ($now<$starttime) { $active=0; }
                   4639:                 }
                   4640:                 if ($endtime) {
                   4641:                     if ($now>$endtime) { $active=0; }
                   4642:                 }
                   4643:                 if ($active) {
1.1058    raeburn  4644:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4645:                     if ($sec eq '') {
                   4646:                         $sec = 'none';
1.1058    raeburn  4647:                     } else {
                   4648:                         $value .= $sec;
                   4649:                     }
                   4650:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4651:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4652:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4653:                         }
                   4654:                     } else {
                   4655:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4656:                     }
1.474     raeburn  4657:                 }
                   4658:             }
1.51      www      4659:         }
                   4660:     }
1.474     raeburn  4661:     return %courses;
1.51      www      4662: }
1.37      matthew  4663: 
1.54      www      4664: ###############################################
1.474     raeburn  4665: 
                   4666: sub blockcheck {
1.1189    raeburn  4667:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4668: 
1.1189    raeburn  4669:     if (defined($udom) && defined($uname)) {
                   4670:         # If uname and udom are for a course, check for blocks in the course.
                   4671:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4672:             my ($startblock,$endblock,$triggerblock) =
                   4673:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4674:             return ($startblock,$endblock,$triggerblock);
                   4675:         }
                   4676:     } else {
1.490     raeburn  4677:         $udom = $env{'user.domain'};
                   4678:         $uname = $env{'user.name'};
                   4679:     }
                   4680: 
1.502     raeburn  4681:     my $startblock = 0;
                   4682:     my $endblock = 0;
1.1062    raeburn  4683:     my $triggerblock = '';
1.482     raeburn  4684:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4685: 
1.490     raeburn  4686:     # If uname is for a user, and activity is course-specific, i.e.,
                   4687:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4688: 
1.490     raeburn  4689:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189    raeburn  4690:          $activity eq 'groups' || $activity eq 'printout') &&
                   4691:         ($env{'request.course.id'})) {
1.490     raeburn  4692:         foreach my $key (keys(%live_courses)) {
                   4693:             if ($key ne $env{'request.course.id'}) {
                   4694:                 delete($live_courses{$key});
                   4695:             }
                   4696:         }
                   4697:     }
                   4698: 
                   4699:     my $otheruser = 0;
                   4700:     my %own_courses;
                   4701:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4702:         # Resource belongs to user other than current user.
                   4703:         $otheruser = 1;
                   4704:         # Gather courses for current user
                   4705:         %own_courses = 
                   4706:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4707:     }
                   4708: 
                   4709:     # Gather active course roles - course coordinator, instructor, 
                   4710:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4711: 
                   4712:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4713:         my ($cdom,$cnum);
                   4714:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4715:             $cdom = $env{'course.'.$course.'.domain'};
                   4716:             $cnum = $env{'course.'.$course.'.num'};
                   4717:         } else {
1.490     raeburn  4718:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4719:         }
                   4720:         my $no_ownblock = 0;
                   4721:         my $no_userblock = 0;
1.533     raeburn  4722:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4723:             # Check if current user has 'evb' priv for this
                   4724:             if (defined($own_courses{$course})) {
                   4725:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4726:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4727:                     if ($sec ne 'none') {
                   4728:                         $checkrole .= '/'.$sec;
                   4729:                     }
                   4730:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4731:                         $no_ownblock = 1;
                   4732:                         last;
                   4733:                     }
                   4734:                 }
                   4735:             }
                   4736:             # if they have 'evb' priv and are currently not playing student
                   4737:             next if (($no_ownblock) &&
                   4738:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4739:         }
1.474     raeburn  4740:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4741:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4742:             if ($sec ne 'none') {
1.482     raeburn  4743:                 $checkrole .= '/'.$sec;
1.474     raeburn  4744:             }
1.490     raeburn  4745:             if ($otheruser) {
                   4746:                 # Resource belongs to user other than current user.
                   4747:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4748:                 my (%allroles,%userroles);
                   4749:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4750:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4751:                         my ($trole,$tdom,$tnum,$tsec);
                   4752:                         if ($entry =~ /^cr/) {
                   4753:                             ($trole,$tdom,$tnum,$tsec) = 
                   4754:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4755:                         } else {
                   4756:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4757:                         }
                   4758:                         my ($spec,$area,$trest);
                   4759:                         $area = '/'.$tdom.'/'.$tnum;
                   4760:                         $trest = $tnum;
                   4761:                         if ($tsec ne '') {
                   4762:                             $area .= '/'.$tsec;
                   4763:                             $trest .= '/'.$tsec;
                   4764:                         }
                   4765:                         $spec = $trole.'.'.$area;
                   4766:                         if ($trole =~ /^cr/) {
                   4767:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4768:                                                               $tdom,$spec,$trest,$area);
                   4769:                         } else {
                   4770:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4771:                                                                 $tdom,$spec,$trest,$area);
                   4772:                         }
                   4773:                     }
                   4774:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4775:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4776:                         if ($1) {
                   4777:                             $no_userblock = 1;
                   4778:                             last;
                   4779:                         }
1.486     raeburn  4780:                     }
                   4781:                 }
1.490     raeburn  4782:             } else {
                   4783:                 # Resource belongs to current user
                   4784:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4785:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4786:                     $no_ownblock = 1;
                   4787:                     last;
                   4788:                 }
1.474     raeburn  4789:             }
                   4790:         }
                   4791:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4792:         next if (($no_ownblock) &&
1.491     albertel 4793:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4794:         next if ($no_userblock);
1.474     raeburn  4795: 
1.866     kalberla 4796:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4797:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4798:         
1.1062    raeburn  4799:         my ($start,$end,$trigger) = 
                   4800:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4801:         if (($start != 0) && 
                   4802:             (($startblock == 0) || ($startblock > $start))) {
                   4803:             $startblock = $start;
1.1062    raeburn  4804:             if ($trigger ne '') {
                   4805:                 $triggerblock = $trigger;
                   4806:             }
1.502     raeburn  4807:         }
                   4808:         if (($end != 0)  &&
                   4809:             (($endblock == 0) || ($endblock < $end))) {
                   4810:             $endblock = $end;
1.1062    raeburn  4811:             if ($trigger ne '') {
                   4812:                 $triggerblock = $trigger;
                   4813:             }
1.502     raeburn  4814:         }
1.490     raeburn  4815:     }
1.1062    raeburn  4816:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4817: }
                   4818: 
                   4819: sub get_blocks {
1.1062    raeburn  4820:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4821:     my $startblock = 0;
                   4822:     my $endblock = 0;
1.1062    raeburn  4823:     my $triggerblock = '';
1.490     raeburn  4824:     my $course = $cdom.'_'.$cnum;
                   4825:     $setters->{$course} = {};
                   4826:     $setters->{$course}{'staff'} = [];
                   4827:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4828:     $setters->{$course}{'triggers'} = [];
                   4829:     my (@blockers,%triggered);
                   4830:     my $now = time;
                   4831:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4832:     if ($activity eq 'docs') {
                   4833:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4834:         foreach my $block (@blockers) {
                   4835:             if ($block =~ /^firstaccess____(.+)$/) {
                   4836:                 my $item = $1;
                   4837:                 my $type = 'map';
                   4838:                 my $timersymb = $item;
                   4839:                 if ($item eq 'course') {
                   4840:                     $type = 'course';
                   4841:                 } elsif ($item =~ /___\d+___/) {
                   4842:                     $type = 'resource';
                   4843:                 } else {
                   4844:                     $timersymb = &Apache::lonnet::symbread($item);
                   4845:                 }
                   4846:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4847:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4848:                 $triggered{$block} = {
                   4849:                                        start => $start,
                   4850:                                        end   => $end,
                   4851:                                        type  => $type,
                   4852:                                      };
                   4853:             }
                   4854:         }
                   4855:     } else {
                   4856:         foreach my $block (keys(%commblocks)) {
                   4857:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4858:                 my ($start,$end) = ($1,$2);
                   4859:                 if ($start <= time && $end >= time) {
                   4860:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4861:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4862:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4863:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4864:                                     push(@blockers,$block);
                   4865:                                 }
                   4866:                             }
                   4867:                         }
                   4868:                     }
                   4869:                 }
                   4870:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4871:                 my $item = $1;
                   4872:                 my $timersymb = $item; 
                   4873:                 my $type = 'map';
                   4874:                 if ($item eq 'course') {
                   4875:                     $type = 'course';
                   4876:                 } elsif ($item =~ /___\d+___/) {
                   4877:                     $type = 'resource';
                   4878:                 } else {
                   4879:                     $timersymb = &Apache::lonnet::symbread($item);
                   4880:                 }
                   4881:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4882:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4883:                 if ($start && $end) {
                   4884:                     if (($start <= time) && ($end >= time)) {
                   4885:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4886:                             push(@blockers,$block);
                   4887:                             $triggered{$block} = {
                   4888:                                                    start => $start,
                   4889:                                                    end   => $end,
                   4890:                                                    type  => $type,
                   4891:                                                  };
                   4892:                         }
                   4893:                     }
1.490     raeburn  4894:                 }
1.1062    raeburn  4895:             }
                   4896:         }
                   4897:     }
                   4898:     foreach my $blocker (@blockers) {
                   4899:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4900:             &parse_block_record($commblocks{$blocker});
                   4901:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4902:         my ($start,$end,$triggertype);
                   4903:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4904:             ($start,$end) = ($1,$2);
                   4905:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4906:             $start = $triggered{$blocker}{'start'};
                   4907:             $end = $triggered{$blocker}{'end'};
                   4908:             $triggertype = $triggered{$blocker}{'type'};
                   4909:         }
                   4910:         if ($start) {
                   4911:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4912:             if ($triggertype) {
                   4913:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4914:             } else {
                   4915:                 push(@{$$setters{$course}{'triggers'}},0);
                   4916:             }
                   4917:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4918:                 $startblock = $start;
                   4919:                 if ($triggertype) {
                   4920:                     $triggerblock = $blocker;
1.474     raeburn  4921:                 }
                   4922:             }
1.1062    raeburn  4923:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4924:                $endblock = $end;
                   4925:                if ($triggertype) {
                   4926:                    $triggerblock = $blocker;
                   4927:                }
                   4928:             }
1.474     raeburn  4929:         }
                   4930:     }
1.1062    raeburn  4931:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4932: }
                   4933: 
                   4934: sub parse_block_record {
                   4935:     my ($record) = @_;
                   4936:     my ($setuname,$setudom,$title,$blocks);
                   4937:     if (ref($record) eq 'HASH') {
                   4938:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4939:         $title = &unescape($record->{'event'});
                   4940:         $blocks = $record->{'blocks'};
                   4941:     } else {
                   4942:         my @data = split(/:/,$record,3);
                   4943:         if (scalar(@data) eq 2) {
                   4944:             $title = $data[1];
                   4945:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4946:         } else {
                   4947:             ($setuname,$setudom,$title) = @data;
                   4948:         }
                   4949:         $blocks = { 'com' => 'on' };
                   4950:     }
                   4951:     return ($setuname,$setudom,$title,$blocks);
                   4952: }
                   4953: 
1.854     kalberla 4954: sub blocking_status {
1.1189    raeburn  4955:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4956:     my %setters;
1.890     droeschl 4957: 
1.1061    raeburn  4958: # check for active blocking
1.1062    raeburn  4959:     my ($startblock,$endblock,$triggerblock) = 
1.1189    raeburn  4960:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4961:     my $blocked = 0;
                   4962:     if ($startblock && $endblock) {
                   4963:         $blocked = 1;
                   4964:     }
1.890     droeschl 4965: 
1.1061    raeburn  4966: # caller just wants to know whether a block is active
                   4967:     if (!wantarray) { return $blocked; }
                   4968: 
                   4969: # build a link to a popup window containing the details
                   4970:     my $querystring  = "?activity=$activity";
                   4971: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232    raeburn  4972:     if (($activity eq 'port') || ($activity eq 'passwd')) {
                   4973:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
                   4974:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  4975:     } elsif ($activity eq 'docs') {
                   4976:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4977:     }
1.1061    raeburn  4978: 
                   4979:     my $output .= <<'END_MYBLOCK';
                   4980: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4981:     var options = "width=" + w + ",height=" + h + ",";
                   4982:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4983:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4984:     var newWin = window.open(url, wdwName, options);
                   4985:     newWin.focus();
                   4986: }
1.890     droeschl 4987: END_MYBLOCK
1.854     kalberla 4988: 
1.1061    raeburn  4989:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4990:   
1.1061    raeburn  4991:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4992:     my $text = &mt('Communication Blocked');
1.1217    raeburn  4993:     my $class = 'LC_comblock';
1.1062    raeburn  4994:     if ($activity eq 'docs') {
                   4995:         $text = &mt('Content Access Blocked');
1.1217    raeburn  4996:         $class = '';
1.1063    raeburn  4997:     } elsif ($activity eq 'printout') {
                   4998:         $text = &mt('Printing Blocked');
1.1232    raeburn  4999:     } elsif ($activity eq 'passwd') {
                   5000:         $text = &mt('Password Changing Blocked');
1.1062    raeburn  5001:     }
1.1061    raeburn  5002:     $output .= <<"END_BLOCK";
1.1217    raeburn  5003: <div class='$class'>
1.869     kalberla 5004:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5005:   title='$text'>
                   5006:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5007:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5008:   title='$text'>$text</a>
1.867     kalberla 5009: </div>
                   5010: 
                   5011: END_BLOCK
1.474     raeburn  5012: 
1.1061    raeburn  5013:     return ($blocked, $output);
1.854     kalberla 5014: }
1.490     raeburn  5015: 
1.60      matthew  5016: ###############################################
                   5017: 
1.682     raeburn  5018: sub check_ip_acc {
1.1201    raeburn  5019:     my ($acc,$clientip)=@_;
1.682     raeburn  5020:     &Apache::lonxml::debug("acc is $acc");
                   5021:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5022:         return 1;
                   5023:     }
1.1219    raeburn  5024:     my $allowed;
1.1201    raeburn  5025:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682     raeburn  5026: 
                   5027:     my $name;
1.1219    raeburn  5028:     my %access = (
                   5029:                      allowfrom => 1,
                   5030:                      denyfrom  => 0,
                   5031:                  );
                   5032:     my @allows;
                   5033:     my @denies;
                   5034:     foreach my $item (split(',',$acc)) {
                   5035:         $item =~ s/^\s*//;
                   5036:         $item =~ s/\s*$//;
                   5037:         my $pattern;
                   5038:         if ($item =~ /^\!(.+)$/) {
                   5039:             push(@denies,$1);
                   5040:         } else {
                   5041:             push(@allows,$item);
                   5042:         }
                   5043:    }
                   5044:    my $numdenies = scalar(@denies);
                   5045:    my $numallows = scalar(@allows);
                   5046:    my $count = 0;
                   5047:    foreach my $pattern (@denies,@allows) {
                   5048:         $count ++; 
                   5049:         my $acctype = 'allowfrom';
                   5050:         if ($count <= $numdenies) {
                   5051:             $acctype = 'denyfrom';
                   5052:         }
1.682     raeburn  5053:         if ($pattern =~ /\*$/) {
                   5054:             #35.8.*
                   5055:             $pattern=~s/\*//;
1.1219    raeburn  5056:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5057:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5058:             #35.8.3.[34-56]
                   5059:             my $low=$2;
                   5060:             my $high=$3;
                   5061:             $pattern=$1;
                   5062:             if ($ip =~ /^\Q$pattern\E/) {
                   5063:                 my $last=(split(/\./,$ip))[3];
1.1219    raeburn  5064:                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  5065:             }
                   5066:         } elsif ($pattern =~ /^\*/) {
                   5067:             #*.msu.edu
                   5068:             $pattern=~s/\*//;
                   5069:             if (!defined($name)) {
                   5070:                 use Socket;
                   5071:                 my $netaddr=inet_aton($ip);
                   5072:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5073:             }
1.1219    raeburn  5074:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  5075:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5076:             #127.0.0.1
1.1219    raeburn  5077:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5078:         } else {
                   5079:             #some.name.com
                   5080:             if (!defined($name)) {
                   5081:                 use Socket;
                   5082:                 my $netaddr=inet_aton($ip);
                   5083:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5084:             }
1.1219    raeburn  5085:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   5086:         }
                   5087:         if ($allowed =~ /^(0|1)$/) { last; }
                   5088:     }
                   5089:     if ($allowed eq '') {
                   5090:         if ($numdenies && !$numallows) {
                   5091:             $allowed = 1;
                   5092:         } else {
                   5093:             $allowed = 0;
1.682     raeburn  5094:         }
                   5095:     }
                   5096:     return $allowed;
                   5097: }
                   5098: 
                   5099: ###############################################
                   5100: 
1.60      matthew  5101: =pod
                   5102: 
1.112     bowersj2 5103: =head1 Domain Template Functions
                   5104: 
                   5105: =over 4
                   5106: 
                   5107: =item * &determinedomain()
1.60      matthew  5108: 
                   5109: Inputs: $domain (usually will be undef)
                   5110: 
1.63      www      5111: Returns: Determines which domain should be used for designs
1.60      matthew  5112: 
                   5113: =cut
1.54      www      5114: 
1.60      matthew  5115: ###############################################
1.63      www      5116: sub determinedomain {
                   5117:     my $domain=shift;
1.531     albertel 5118:     if (! $domain) {
1.60      matthew  5119:         # Determine domain if we have not been given one
1.893     raeburn  5120:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5121:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5122:         if ($env{'request.role.domain'}) { 
                   5123:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5124:         }
                   5125:     }
1.63      www      5126:     return $domain;
                   5127: }
                   5128: ###############################################
1.517     raeburn  5129: 
1.518     albertel 5130: sub devalidate_domconfig_cache {
                   5131:     my ($udom)=@_;
                   5132:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5133: }
                   5134: 
                   5135: # ---------------------- Get domain configuration for a domain
                   5136: sub get_domainconf {
                   5137:     my ($udom) = @_;
                   5138:     my $cachetime=1800;
                   5139:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5140:     if (defined($cached)) { return %{$result}; }
                   5141: 
                   5142:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5143: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5144:     my (%designhash,%legacy);
1.518     albertel 5145:     if (keys(%domconfig) > 0) {
                   5146:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5147:             if (keys(%{$domconfig{'login'}})) {
                   5148:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5149:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208    raeburn  5150:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5151:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5152:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5153:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5154:                                         if ($key eq 'loginvia') {
                   5155:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5156:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5157:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5158:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5159: 
                   5160:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5161:                                                 } else {
                   5162:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5163:                                                 }
1.948     raeburn  5164:                                             }
1.1208    raeburn  5165:                                         } elsif ($key eq 'headtag') {
                   5166:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5167:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5168:                                             }
1.946     raeburn  5169:                                         }
1.1208    raeburn  5170:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5171:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5172:                                         }
1.946     raeburn  5173:                                     }
                   5174:                                 }
                   5175:                             }
                   5176:                         } else {
                   5177:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5178:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5179:                                     $domconfig{'login'}{$key}{$img};
                   5180:                             }
1.699     raeburn  5181:                         }
                   5182:                     } else {
                   5183:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5184:                     }
1.632     raeburn  5185:                 }
                   5186:             } else {
                   5187:                 $legacy{'login'} = 1;
1.518     albertel 5188:             }
1.632     raeburn  5189:         } else {
                   5190:             $legacy{'login'} = 1;
1.518     albertel 5191:         }
                   5192:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5193:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5194:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5195:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5196:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5197:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5198:                         }
1.518     albertel 5199:                     }
                   5200:                 }
1.632     raeburn  5201:             } else {
                   5202:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5203:             }
1.632     raeburn  5204:         } else {
                   5205:             $legacy{'rolecolors'} = 1;
1.518     albertel 5206:         }
1.948     raeburn  5207:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5208:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5209:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5210:             }
                   5211:         }
1.632     raeburn  5212:         if (keys(%legacy) > 0) {
                   5213:             my %legacyhash = &get_legacy_domconf($udom);
                   5214:             foreach my $item (keys(%legacyhash)) {
                   5215:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5216:                     if ($legacy{'login'}) { 
                   5217:                         $designhash{$item} = $legacyhash{$item};
                   5218:                     }
                   5219:                 } else {
                   5220:                     if ($legacy{'rolecolors'}) {
                   5221:                         $designhash{$item} = $legacyhash{$item};
                   5222:                     }
1.518     albertel 5223:                 }
                   5224:             }
                   5225:         }
1.632     raeburn  5226:     } else {
                   5227:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5228:     }
                   5229:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5230: 				  $cachetime);
                   5231:     return %designhash;
                   5232: }
                   5233: 
1.632     raeburn  5234: sub get_legacy_domconf {
                   5235:     my ($udom) = @_;
                   5236:     my %legacyhash;
                   5237:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5238:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5239:     if (-e $designfile) {
                   5240:         if ( open (my $fh,"<$designfile") ) {
                   5241:             while (my $line = <$fh>) {
                   5242:                 next if ($line =~ /^\#/);
                   5243:                 chomp($line);
                   5244:                 my ($key,$val)=(split(/\=/,$line));
                   5245:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5246:             }
                   5247:             close($fh);
                   5248:         }
                   5249:     }
1.1026    raeburn  5250:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5251:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5252:     }
                   5253:     return %legacyhash;
                   5254: }
                   5255: 
1.63      www      5256: =pod
                   5257: 
1.112     bowersj2 5258: =item * &domainlogo()
1.63      www      5259: 
                   5260: Inputs: $domain (usually will be undef)
                   5261: 
                   5262: Returns: A link to a domain logo, if the domain logo exists.
                   5263: If the domain logo does not exist, a description of the domain.
                   5264: 
                   5265: =cut
1.112     bowersj2 5266: 
1.63      www      5267: ###############################################
                   5268: sub domainlogo {
1.517     raeburn  5269:     my $domain = &determinedomain(shift);
1.518     albertel 5270:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5271:     # See if there is a logo
                   5272:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5273:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5274:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5275: 	    if ($imgsrc =~ m{^/res/}) {
                   5276: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5277: 		&Apache::lonnet::repcopy($local_name);
                   5278: 	    }
                   5279: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  5280:         } 
                   5281:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 5282:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5283:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5284:     } else {
1.60      matthew  5285:         return '';
1.59      www      5286:     }
                   5287: }
1.63      www      5288: ##############################################
                   5289: 
                   5290: =pod
                   5291: 
1.112     bowersj2 5292: =item * &designparm()
1.63      www      5293: 
                   5294: Inputs: $which parameter; $domain (usually will be undef)
                   5295: 
                   5296: Returns: value of designparamter $which
                   5297: 
                   5298: =cut
1.112     bowersj2 5299: 
1.397     albertel 5300: 
1.400     albertel 5301: ##############################################
1.397     albertel 5302: sub designparm {
                   5303:     my ($which,$domain)=@_;
                   5304:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5305:         return $env{'environment.color.'.$which};
1.96      www      5306:     }
1.63      www      5307:     $domain=&determinedomain($domain);
1.1016    raeburn  5308:     my %domdesign;
                   5309:     unless ($domain eq 'public') {
                   5310:         %domdesign = &get_domainconf($domain);
                   5311:     }
1.520     raeburn  5312:     my $output;
1.517     raeburn  5313:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5314:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5315:     } else {
1.520     raeburn  5316:         $output = $defaultdesign{$which};
                   5317:     }
                   5318:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5319:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5320:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5321:             if ($output =~ m{^/res/}) {
                   5322:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5323:                 &Apache::lonnet::repcopy($local_name);
                   5324:             }
1.520     raeburn  5325:             $output = &lonhttpdurl($output);
                   5326:         }
1.63      www      5327:     }
1.520     raeburn  5328:     return $output;
1.63      www      5329: }
1.59      www      5330: 
1.822     bisitz   5331: ##############################################
                   5332: =pod
                   5333: 
1.832     bisitz   5334: =item * &authorspace()
                   5335: 
1.1028    raeburn  5336: Inputs: $url (usually will be undef).
1.832     bisitz   5337: 
1.1132    raeburn  5338: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5339:          directory being viewed (or for which action is being taken). 
                   5340:          If $url is provided, and begins /priv/<domain>/<uname>
                   5341:          the path will be that portion of the $context argument.
                   5342:          Otherwise the path will be for the author space of the current
                   5343:          user when the current role is author, or for that of the 
                   5344:          co-author/assistant co-author space when the current role 
                   5345:          is co-author or assistant co-author.
1.832     bisitz   5346: 
                   5347: =cut
                   5348: 
                   5349: sub authorspace {
1.1028    raeburn  5350:     my ($url) = @_;
                   5351:     if ($url ne '') {
                   5352:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5353:            return $1;
                   5354:         }
                   5355:     }
1.832     bisitz   5356:     my $caname = '';
1.1024    www      5357:     my $cadom = '';
1.1028    raeburn  5358:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5359:         ($cadom,$caname) =
1.832     bisitz   5360:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5361:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5362:         $caname = $env{'user.name'};
1.1024    www      5363:         $cadom = $env{'user.domain'};
1.832     bisitz   5364:     }
1.1028    raeburn  5365:     if (($caname ne '') && ($cadom ne '')) {
                   5366:         return "/priv/$cadom/$caname/";
                   5367:     }
                   5368:     return;
1.832     bisitz   5369: }
                   5370: 
                   5371: ##############################################
                   5372: =pod
                   5373: 
1.822     bisitz   5374: =item * &head_subbox()
                   5375: 
                   5376: Inputs: $content (contains HTML code with page functions, etc.)
                   5377: 
                   5378: Returns: HTML div with $content
                   5379:          To be included in page header
                   5380: 
                   5381: =cut
                   5382: 
                   5383: sub head_subbox {
                   5384:     my ($content)=@_;
                   5385:     my $output =
1.993     raeburn  5386:         '<div class="LC_head_subbox">'
1.822     bisitz   5387:        .$content
                   5388:        .'</div>'
                   5389: }
                   5390: 
                   5391: ##############################################
                   5392: =pod
                   5393: 
                   5394: =item * &CSTR_pageheader()
                   5395: 
1.1026    raeburn  5396: Input: (optional) filename from which breadcrumb trail is built.
                   5397:        In most cases no input as needed, as $env{'request.filename'}
                   5398:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5399: 
                   5400: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5401:          To be included on Authoring Space pages
1.822     bisitz   5402: 
                   5403: =cut
                   5404: 
                   5405: sub CSTR_pageheader {
1.1026    raeburn  5406:     my ($trailfile) = @_;
                   5407:     if ($trailfile eq '') {
                   5408:         $trailfile = $env{'request.filename'};
                   5409:     }
                   5410: 
                   5411: # this is for resources; directories have customtitle, and crumbs
                   5412: # and select recent are created in lonpubdir.pm
                   5413: 
                   5414:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5415:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5416:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5417:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5418:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5419: 
                   5420:     my $parentpath = '';
                   5421:     my $lastitem = '';
                   5422:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5423:         $parentpath = $1;
                   5424:         $lastitem = $2;
                   5425:     } else {
                   5426:         $lastitem = $thisdisfn;
                   5427:     }
1.921     bisitz   5428: 
1.1246  ! raeburn  5429:     my ($crsauthor,$title);
        !          5430:     if (($env{'request.course.id'}) &&
        !          5431:         ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
        !          5432:         ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname)) {
        !          5433:         $crsauthor = 1;
        !          5434:         $title = &mt('Course Authoring Space');
        !          5435:     } else {
        !          5436:         $title = &mt('Authoring Space');
        !          5437:     }
        !          5438: 
1.921     bisitz   5439:     my $output =
1.822     bisitz   5440:          '<div>'
                   5441:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246  ! raeburn  5442:         .'<b>'.$title.'</b> '
1.822     bisitz   5443:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5444:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5445:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5446: 
                   5447:     if ($lastitem) {
                   5448:         $output .=
                   5449:              '<span class="LC_filename">'
                   5450:             .$lastitem
                   5451:             .'</span>';
                   5452:     }
1.1245    raeburn  5453: 
1.1246  ! raeburn  5454:     if ($crsauthor) {
        !          5455:         $output .= '</form>'.&Apache::lonmenu::constspaceform();
        !          5456:     } else {
        !          5457:         $output .=
        !          5458:              '<br />'
        !          5459:             #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
        !          5460:             .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
        !          5461:             .'</form>'
        !          5462:             .&Apache::lonmenu::constspaceform();
        !          5463:     }
        !          5464:     $output .= '</div>';
1.921     bisitz   5465: 
                   5466:     return $output;
1.822     bisitz   5467: }
                   5468: 
1.60      matthew  5469: ###############################################
                   5470: ###############################################
                   5471: 
                   5472: =pod
                   5473: 
1.112     bowersj2 5474: =back
                   5475: 
1.549     albertel 5476: =head1 HTML Helpers
1.112     bowersj2 5477: 
                   5478: =over 4
                   5479: 
                   5480: =item * &bodytag()
1.60      matthew  5481: 
                   5482: Returns a uniform header for LON-CAPA web pages.
                   5483: 
                   5484: Inputs: 
                   5485: 
1.112     bowersj2 5486: =over 4
                   5487: 
                   5488: =item * $title, A title to be displayed on the page.
                   5489: 
                   5490: =item * $function, the current role (can be undef).
                   5491: 
                   5492: =item * $addentries, extra parameters for the <body> tag.
                   5493: 
                   5494: =item * $bodyonly, if defined, only return the <body> tag.
                   5495: 
                   5496: =item * $domain, if defined, force a given domain.
                   5497: 
                   5498: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5499:             text interface only)
1.60      matthew  5500: 
1.814     bisitz   5501: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5502:                      navigational links
1.317     albertel 5503: 
1.338     albertel 5504: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5505: 
1.460     albertel 5506: =item * $args, optional argument valid values are
                   5507:             no_auto_mt_title -> prevents &mt()ing the title arg
                   5508: 
1.1096    raeburn  5509: =item * $advtoolsref, optional argument, ref to an array containing
                   5510:             inlineremote items to be added in "Functions" menu below
                   5511:             breadcrumbs.
                   5512: 
1.112     bowersj2 5513: =back
                   5514: 
1.60      matthew  5515: Returns: A uniform header for LON-CAPA web pages.  
                   5516: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5517: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5518: other decorations will be returned.
                   5519: 
                   5520: =cut
                   5521: 
1.54      www      5522: sub bodytag {
1.831     bisitz   5523:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5524:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5525: 
1.954     raeburn  5526:     my $public;
                   5527:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5528:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5529:         $public = 1;
                   5530:     }
1.460     albertel 5531:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  5532:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5533: 
1.183     matthew  5534:     $function = &get_users_function() if (!$function);
1.339     albertel 5535:     my $img =    &designparm($function.'.img',$domain);
                   5536:     my $font =   &designparm($function.'.font',$domain);
                   5537:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5538: 
1.803     bisitz   5539:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5540: 		   'bgcolor' => $pgbg,
1.339     albertel 5541: 		   'text'    => $font,
                   5542:                    'alink'   => &designparm($function.'.alink',$domain),
                   5543: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5544: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5545:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5546: 
1.63      www      5547:  # role and realm
1.1178    raeburn  5548:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5549:     if ($realm) {
                   5550:         $realm = '/'.$realm;
                   5551:     }
1.378     raeburn  5552:     if ($role  eq 'ca') {
1.479     albertel 5553:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5554:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5555:     } 
1.55      www      5556: # realm
1.258     albertel 5557:     if ($env{'request.course.id'}) {
1.378     raeburn  5558:         if ($env{'request.role'} !~ /^cr/) {
                   5559:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5560:         }
1.898     raeburn  5561:         if ($env{'request.course.sec'}) {
                   5562:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5563:         }   
1.359     albertel 5564: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5565:     } else {
                   5566:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5567:     }
1.433     albertel 5568: 
1.359     albertel 5569:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5570: 
1.438     albertel 5571:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5572: 
1.101     www      5573: # construct main body tag
1.359     albertel 5574:     my $bodytag = "<body $extra_body_attr>".
1.1235    raeburn  5575: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 5576: 
1.1131    raeburn  5577:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5578: 
1.1130    raeburn  5579:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5580:         return $bodytag;
1.1130    raeburn  5581:     }
1.359     albertel 5582: 
1.954     raeburn  5583:     if ($public) {
1.433     albertel 5584: 	undef($role);
                   5585:     }
1.359     albertel 5586:     
1.762     bisitz   5587:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5588:     #
                   5589:     # Extra info if you are the DC
                   5590:     my $dc_info = '';
                   5591:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5592:                         $env{'course.'.$env{'request.course.id'}.
                   5593:                                  '.domain'}.'/'})) {
                   5594:         my $cid = $env{'request.course.id'};
1.917     raeburn  5595:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5596:         $dc_info =~ s/\s+$//;
1.359     albertel 5597:     }
                   5598: 
1.1237    raeburn  5599:     my $crstype;
                   5600:     if ($env{'request.course.id'}) {
                   5601:         $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5602:     } elsif ($args->{'crstype'}) {
                   5603:         $crstype = $args->{'crstype'};
                   5604:     }
                   5605:     if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
                   5606:         undef($role);
                   5607:     } else {
1.1242    raeburn  5608:         $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237    raeburn  5609:     }
1.853     droeschl 5610: 
1.903     droeschl 5611:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5612: 
                   5613:         #    if ($env{'request.state'} eq 'construct') {
                   5614:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5615:         #    }
                   5616: 
1.1130    raeburn  5617:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  5618:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5619: 
1.1237    raeburn  5620:         my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359     albertel 5621: 
1.916     droeschl 5622:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5623:              if ($dc_info) {
                   5624:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5625:              }
1.1130    raeburn  5626:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5627:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5628:             return $bodytag;
                   5629:         }
1.894     droeschl 5630: 
1.927     raeburn  5631:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5632:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5633:         }
1.916     droeschl 5634: 
1.1130    raeburn  5635:         $bodytag .= $right;
1.852     droeschl 5636: 
1.917     raeburn  5637:         if ($dc_info) {
                   5638:             $dc_info = &dc_courseid_toggle($dc_info);
                   5639:         }
                   5640:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5641: 
1.1169    raeburn  5642:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  5643:         if ($args->{'no_secondary_menu'}) {
                   5644:             return $bodytag;
                   5645:         }
1.1169    raeburn  5646:         #don't show menus for public users
1.954     raeburn  5647:         if (!$public){
1.1154    raeburn  5648:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5649:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5650:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5651:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5652:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5653:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5654:             } elsif ($forcereg) {
                   5655:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5656:                                                             $args->{'group'});
                   5657:             } else {
                   5658:                 $bodytag .= 
                   5659:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5660:                                                         $forcereg,$args->{'group'},
                   5661:                                                         $args->{'bread_crumbs'},
                   5662:                                                         $advtoolsref);
1.920     raeburn  5663:             }
1.903     droeschl 5664:         }else{
                   5665:             # this is to seperate menu from content when there's no secondary
                   5666:             # menu. Especially needed for public accessible ressources.
                   5667:             $bodytag .= '<hr style="clear:both" />';
                   5668:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5669:         }
1.903     droeschl 5670: 
1.235     raeburn  5671:         return $bodytag;
1.182     matthew  5672: }
                   5673: 
1.917     raeburn  5674: sub dc_courseid_toggle {
                   5675:     my ($dc_info) = @_;
1.980     raeburn  5676:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5677:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5678:            &mt('(More ...)').'</a></span>'.
                   5679:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5680: }
                   5681: 
1.330     albertel 5682: sub make_attr_string {
                   5683:     my ($register,$attr_ref) = @_;
                   5684: 
                   5685:     if ($attr_ref && !ref($attr_ref)) {
                   5686: 	die("addentries Must be a hash ref ".
                   5687: 	    join(':',caller(1))." ".
                   5688: 	    join(':',caller(0))." ");
                   5689:     }
                   5690: 
                   5691:     if ($register) {
1.339     albertel 5692: 	my ($on_load,$on_unload);
                   5693: 	foreach my $key (keys(%{$attr_ref})) {
                   5694: 	    if      (lc($key) eq 'onload') {
                   5695: 		$on_load.=$attr_ref->{$key}.';';
                   5696: 		delete($attr_ref->{$key});
                   5697: 
                   5698: 	    } elsif (lc($key) eq 'onunload') {
                   5699: 		$on_unload.=$attr_ref->{$key}.';';
                   5700: 		delete($attr_ref->{$key});
                   5701: 	    }
                   5702: 	}
1.953     droeschl 5703: 	$attr_ref->{'onload'}  = $on_load;
                   5704: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5705:     }
1.339     albertel 5706: 
1.330     albertel 5707:     my $attr_string;
1.1159    raeburn  5708:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5709: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5710:     }
                   5711:     return $attr_string;
                   5712: }
                   5713: 
                   5714: 
1.182     matthew  5715: ###############################################
1.251     albertel 5716: ###############################################
                   5717: 
                   5718: =pod
                   5719: 
                   5720: =item * &endbodytag()
                   5721: 
                   5722: Returns a uniform footer for LON-CAPA web pages.
                   5723: 
1.635     raeburn  5724: Inputs: 1 - optional reference to an args hash
                   5725: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5726: a 'Continue' link is not displayed if the page contains an
                   5727: internal redirect in the <head></head> section,
                   5728: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5729: 
                   5730: =cut
                   5731: 
                   5732: sub endbodytag {
1.635     raeburn  5733:     my ($args) = @_;
1.1080    raeburn  5734:     my $endbodytag;
                   5735:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5736:         $endbodytag='</body>';
                   5737:     }
1.315     albertel 5738:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5739:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5740: 	    $endbodytag=
                   5741: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5742: 	        &mt('Continue').'</a>'.
                   5743: 	        $endbodytag;
                   5744:         }
1.315     albertel 5745:     }
1.251     albertel 5746:     return $endbodytag;
                   5747: }
                   5748: 
1.352     albertel 5749: =pod
                   5750: 
                   5751: =item * &standard_css()
                   5752: 
                   5753: Returns a style sheet
                   5754: 
                   5755: Inputs: (all optional)
                   5756:             domain         -> force to color decorate a page for a specific
                   5757:                                domain
                   5758:             function       -> force usage of a specific rolish color scheme
                   5759:             bgcolor        -> override the default page bgcolor
                   5760: 
                   5761: =cut
                   5762: 
1.343     albertel 5763: sub standard_css {
1.345     albertel 5764:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5765:     $function  = &get_users_function() if (!$function);
                   5766:     my $img    = &designparm($function.'.img',   $domain);
                   5767:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5768:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5769:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5770: #second colour for later usage
1.345     albertel 5771:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5772:     my $pgbg_or_bgcolor =
                   5773: 	         $bgcolor ||
1.352     albertel 5774: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5775:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5776:     my $alink  = &designparm($function.'.alink', $domain);
                   5777:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5778:     my $link   = &designparm($function.'.link',  $domain);
                   5779: 
1.602     albertel 5780:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5781:     my $mono                 = 'monospace';
1.850     bisitz   5782:     my $data_table_head      = $sidebg;
                   5783:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5784:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5785:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5786:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5787:     my $mail_new             = '#FFBB77';
                   5788:     my $mail_new_hover       = '#DD9955';
                   5789:     my $mail_read            = '#BBBB77';
                   5790:     my $mail_read_hover      = '#999944';
                   5791:     my $mail_replied         = '#AAAA88';
                   5792:     my $mail_replied_hover   = '#888855';
                   5793:     my $mail_other           = '#99BBBB';
                   5794:     my $mail_other_hover     = '#669999';
1.391     albertel 5795:     my $table_header         = '#DDDDDD';
1.489     raeburn  5796:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5797:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5798:     my $button_hover         = '#BF2317';
1.392     albertel 5799: 
1.608     albertel 5800:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5801:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5802:                                              : '0 3px 0 4px';
1.448     albertel 5803: 
1.523     albertel 5804: 
1.343     albertel 5805:     return <<END;
1.947     droeschl 5806: 
                   5807: /* needed for iframe to allow 100% height in FF */
                   5808: body, html { 
                   5809:     margin: 0;
                   5810:     padding: 0 0.5%;
                   5811:     height: 99%; /* to avoid scrollbars */
                   5812: }
                   5813: 
1.795     www      5814: body {
1.911     bisitz   5815:   font-family: $sans;
                   5816:   line-height:130%;
                   5817:   font-size:0.83em;
                   5818:   color:$font;
1.795     www      5819: }
                   5820: 
1.959     onken    5821: a:focus,
                   5822: a:focus img {
1.795     www      5823:   color: red;
                   5824: }
1.698     harmsja  5825: 
1.911     bisitz   5826: form, .inline {
                   5827:   display: inline;
1.795     www      5828: }
1.721     harmsja  5829: 
1.795     www      5830: .LC_right {
1.911     bisitz   5831:   text-align:right;
1.795     www      5832: }
                   5833: 
                   5834: .LC_middle {
1.911     bisitz   5835:   vertical-align:middle;
1.795     www      5836: }
1.721     harmsja  5837: 
1.1130    raeburn  5838: .LC_floatleft {
                   5839:   float: left;
                   5840: }
                   5841: 
                   5842: .LC_floatright {
                   5843:   float: right;
                   5844: }
                   5845: 
1.911     bisitz   5846: .LC_400Box {
                   5847:   width:400px;
                   5848: }
1.721     harmsja  5849: 
1.947     droeschl 5850: .LC_iframecontainer {
                   5851:     width: 98%;
                   5852:     margin: 0;
                   5853:     position: fixed;
                   5854:     top: 8.5em;
                   5855:     bottom: 0;
                   5856: }
                   5857: 
                   5858: .LC_iframecontainer iframe{
                   5859:     border: none;
                   5860:     width: 100%;
                   5861:     height: 100%;
                   5862: }
                   5863: 
1.778     bisitz   5864: .LC_filename {
                   5865:   font-family: $mono;
                   5866:   white-space:pre;
1.921     bisitz   5867:   font-size: 120%;
1.778     bisitz   5868: }
                   5869: 
                   5870: .LC_fileicon {
                   5871:   border: none;
                   5872:   height: 1.3em;
                   5873:   vertical-align: text-bottom;
                   5874:   margin-right: 0.3em;
                   5875:   text-decoration:none;
                   5876: }
                   5877: 
1.1008    www      5878: .LC_setting {
                   5879:   text-decoration:underline;
                   5880: }
                   5881: 
1.350     albertel 5882: .LC_error {
                   5883:   color: red;
                   5884: }
1.795     www      5885: 
1.1097    bisitz   5886: .LC_warning {
                   5887:   color: darkorange;
                   5888: }
                   5889: 
1.457     albertel 5890: .LC_diff_removed {
1.733     bisitz   5891:   color: red;
1.394     albertel 5892: }
1.532     albertel 5893: 
                   5894: .LC_info,
1.457     albertel 5895: .LC_success,
                   5896: .LC_diff_added {
1.350     albertel 5897:   color: green;
                   5898: }
1.795     www      5899: 
1.802     bisitz   5900: div.LC_confirm_box {
                   5901:   background-color: #FAFAFA;
                   5902:   border: 1px solid $lg_border_color;
                   5903:   margin-right: 0;
                   5904:   padding: 5px;
                   5905: }
                   5906: 
                   5907: div.LC_confirm_box .LC_error img,
                   5908: div.LC_confirm_box .LC_success img {
                   5909:   vertical-align: middle;
                   5910: }
                   5911: 
1.1242    raeburn  5912: .LC_maxwidth {
                   5913:   max-width: 100%;
                   5914:   height: auto;
                   5915: }
                   5916: 
1.1243    raeburn  5917: .LC_textsize_mobile {
                   5918:   \@media only screen and (max-device-width: 480px) {
                   5919:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   5920:   }
                   5921: }
                   5922: 
1.440     albertel 5923: .LC_icon {
1.771     droeschl 5924:   border: none;
1.790     droeschl 5925:   vertical-align: middle;
1.771     droeschl 5926: }
                   5927: 
1.543     albertel 5928: .LC_docs_spacer {
                   5929:   width: 25px;
                   5930:   height: 1px;
1.771     droeschl 5931:   border: none;
1.543     albertel 5932: }
1.346     albertel 5933: 
1.532     albertel 5934: .LC_internal_info {
1.735     bisitz   5935:   color: #999999;
1.532     albertel 5936: }
                   5937: 
1.794     www      5938: .LC_discussion {
1.1050    www      5939:   background: $data_table_dark;
1.911     bisitz   5940:   border: 1px solid black;
                   5941:   margin: 2px;
1.794     www      5942: }
                   5943: 
                   5944: .LC_disc_action_left {
1.1050    www      5945:   background: $sidebg;
1.911     bisitz   5946:   text-align: left;
1.1050    www      5947:   padding: 4px;
                   5948:   margin: 2px;
1.794     www      5949: }
                   5950: 
                   5951: .LC_disc_action_right {
1.1050    www      5952:   background: $sidebg;
1.911     bisitz   5953:   text-align: right;
1.1050    www      5954:   padding: 4px;
                   5955:   margin: 2px;
1.794     www      5956: }
                   5957: 
                   5958: .LC_disc_new_item {
1.911     bisitz   5959:   background: white;
                   5960:   border: 2px solid red;
1.1050    www      5961:   margin: 4px;
                   5962:   padding: 4px;
1.794     www      5963: }
                   5964: 
                   5965: .LC_disc_old_item {
1.911     bisitz   5966:   background: white;
1.1050    www      5967:   margin: 4px;
                   5968:   padding: 4px;
1.794     www      5969: }
                   5970: 
1.458     albertel 5971: table.LC_pastsubmission {
                   5972:   border: 1px solid black;
                   5973:   margin: 2px;
                   5974: }
                   5975: 
1.924     bisitz   5976: table#LC_menubuttons {
1.345     albertel 5977:   width: 100%;
                   5978:   background: $pgbg;
1.392     albertel 5979:   border: 2px;
1.402     albertel 5980:   border-collapse: separate;
1.803     bisitz   5981:   padding: 0;
1.345     albertel 5982: }
1.392     albertel 5983: 
1.801     tempelho 5984: table#LC_title_bar a {
                   5985:   color: $fontmenu;
                   5986: }
1.836     bisitz   5987: 
1.807     droeschl 5988: table#LC_title_bar {
1.819     tempelho 5989:   clear: both;
1.836     bisitz   5990:   display: none;
1.807     droeschl 5991: }
                   5992: 
1.795     www      5993: table#LC_title_bar,
1.933     droeschl 5994: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5995: table#LC_title_bar.LC_with_remote {
1.359     albertel 5996:   width: 100%;
1.392     albertel 5997:   border-color: $pgbg;
                   5998:   border-style: solid;
                   5999:   border-width: $border;
1.379     albertel 6000:   background: $pgbg;
1.801     tempelho 6001:   color: $fontmenu;
1.392     albertel 6002:   border-collapse: collapse;
1.803     bisitz   6003:   padding: 0;
1.819     tempelho 6004:   margin: 0;
1.359     albertel 6005: }
1.795     www      6006: 
1.933     droeschl 6007: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 6008:     margin: 0;
                   6009:     padding: 0;
1.933     droeschl 6010:     position: relative;
                   6011:     list-style: none;
1.913     droeschl 6012: }
1.933     droeschl 6013: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 6014:     display: inline;
                   6015: }
1.933     droeschl 6016: 
                   6017: .LC_breadcrumb_tools_navigation {
1.913     droeschl 6018:     padding: 0;
1.933     droeschl 6019:     margin: 0;
                   6020:     float: left;
1.913     droeschl 6021: }
1.933     droeschl 6022: .LC_breadcrumb_tools_tools {
                   6023:     padding: 0;
                   6024:     margin: 0;
1.913     droeschl 6025:     float: right;
                   6026: }
                   6027: 
1.1240    raeburn  6028: .LC_placement_prog {
                   6029:     padding-right: 20px;
                   6030:     font-weight: bold;
                   6031:     font-size: 90%;
                   6032: }
                   6033: 
1.359     albertel 6034: table#LC_title_bar td {
                   6035:   background: $tabbg;
                   6036: }
1.795     www      6037: 
1.911     bisitz   6038: table#LC_menubuttons img {
1.803     bisitz   6039:   border: none;
1.346     albertel 6040: }
1.795     www      6041: 
1.842     droeschl 6042: .LC_breadcrumbs_component {
1.911     bisitz   6043:   float: right;
                   6044:   margin: 0 1em;
1.357     albertel 6045: }
1.842     droeschl 6046: .LC_breadcrumbs_component img {
1.911     bisitz   6047:   vertical-align: middle;
1.777     tempelho 6048: }
1.795     www      6049: 
1.1243    raeburn  6050: .LC_breadcrumbs_hoverable {
                   6051:   background: $sidebg;
                   6052: }
                   6053: 
1.383     albertel 6054: td.LC_table_cell_checkbox {
                   6055:   text-align: center;
                   6056: }
1.795     www      6057: 
                   6058: .LC_fontsize_small {
1.911     bisitz   6059:   font-size: 70%;
1.705     tempelho 6060: }
                   6061: 
1.844     bisitz   6062: #LC_breadcrumbs {
1.911     bisitz   6063:   clear:both;
                   6064:   background: $sidebg;
                   6065:   border-bottom: 1px solid $lg_border_color;
                   6066:   line-height: 2.5em;
1.933     droeschl 6067:   overflow: hidden;
1.911     bisitz   6068:   margin: 0;
                   6069:   padding: 0;
1.995     raeburn  6070:   text-align: left;
1.819     tempelho 6071: }
1.862     bisitz   6072: 
1.1098    bisitz   6073: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6074:   clear:both;
                   6075:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6076:   border: 1px solid $sidebg;
1.1098    bisitz   6077:   margin: 0 0 10px 0;
1.966     bisitz   6078:   padding: 3px;
1.995     raeburn  6079:   text-align: left;
1.822     bisitz   6080: }
                   6081: 
1.795     www      6082: .LC_fontsize_medium {
1.911     bisitz   6083:   font-size: 85%;
1.705     tempelho 6084: }
                   6085: 
1.795     www      6086: .LC_fontsize_large {
1.911     bisitz   6087:   font-size: 120%;
1.705     tempelho 6088: }
                   6089: 
1.346     albertel 6090: .LC_menubuttons_inline_text {
                   6091:   color: $font;
1.698     harmsja  6092:   font-size: 90%;
1.701     harmsja  6093:   padding-left:3px;
1.346     albertel 6094: }
                   6095: 
1.934     droeschl 6096: .LC_menubuttons_inline_text img{
                   6097:   vertical-align: middle;
                   6098: }
                   6099: 
1.1051    www      6100: li.LC_menubuttons_inline_text img {
1.951     onken    6101:   cursor:pointer;
1.1002    droeschl 6102:   text-decoration: none;
1.951     onken    6103: }
                   6104: 
1.526     www      6105: .LC_menubuttons_link {
                   6106:   text-decoration: none;
                   6107: }
1.795     www      6108: 
1.522     albertel 6109: .LC_menubuttons_category {
1.521     www      6110:   color: $font;
1.526     www      6111:   background: $pgbg;
1.521     www      6112:   font-size: larger;
                   6113:   font-weight: bold;
                   6114: }
                   6115: 
1.346     albertel 6116: td.LC_menubuttons_text {
1.911     bisitz   6117:   color: $font;
1.346     albertel 6118: }
1.706     harmsja  6119: 
1.346     albertel 6120: .LC_current_location {
                   6121:   background: $tabbg;
                   6122: }
1.795     www      6123: 
1.938     bisitz   6124: table.LC_data_table {
1.347     albertel 6125:   border: 1px solid #000000;
1.402     albertel 6126:   border-collapse: separate;
1.426     albertel 6127:   border-spacing: 1px;
1.610     albertel 6128:   background: $pgbg;
1.347     albertel 6129: }
1.795     www      6130: 
1.422     albertel 6131: .LC_data_table_dense {
                   6132:   font-size: small;
                   6133: }
1.795     www      6134: 
1.507     raeburn  6135: table.LC_nested_outer {
                   6136:   border: 1px solid #000000;
1.589     raeburn  6137:   border-collapse: collapse;
1.803     bisitz   6138:   border-spacing: 0;
1.507     raeburn  6139:   width: 100%;
                   6140: }
1.795     www      6141: 
1.879     raeburn  6142: table.LC_innerpickbox,
1.507     raeburn  6143: table.LC_nested {
1.803     bisitz   6144:   border: none;
1.589     raeburn  6145:   border-collapse: collapse;
1.803     bisitz   6146:   border-spacing: 0;
1.507     raeburn  6147:   width: 100%;
                   6148: }
1.795     www      6149: 
1.911     bisitz   6150: table.LC_data_table tr th,
                   6151: table.LC_calendar tr th,
1.879     raeburn  6152: table.LC_prior_tries tr th,
                   6153: table.LC_innerpickbox tr th {
1.349     albertel 6154:   font-weight: bold;
                   6155:   background-color: $data_table_head;
1.801     tempelho 6156:   color:$fontmenu;
1.701     harmsja  6157:   font-size:90%;
1.347     albertel 6158: }
1.795     www      6159: 
1.879     raeburn  6160: table.LC_innerpickbox tr th,
                   6161: table.LC_innerpickbox tr td {
                   6162:   vertical-align: top;
                   6163: }
                   6164: 
1.711     raeburn  6165: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   6166:   background-color: #CCCCCC;
1.711     raeburn  6167:   font-weight: bold;
                   6168:   text-align: left;
                   6169: }
1.795     www      6170: 
1.912     bisitz   6171: table.LC_data_table tr.LC_odd_row > td {
                   6172:   background-color: $data_table_light;
                   6173:   padding: 2px;
                   6174:   vertical-align: top;
                   6175: }
                   6176: 
1.809     bisitz   6177: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 6178:   background-color: $data_table_light;
1.912     bisitz   6179:   vertical-align: top;
                   6180: }
                   6181: 
                   6182: table.LC_data_table tr.LC_even_row > td {
                   6183:   background-color: $data_table_dark;
1.425     albertel 6184:   padding: 2px;
1.900     bisitz   6185:   vertical-align: top;
1.347     albertel 6186: }
1.795     www      6187: 
1.809     bisitz   6188: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 6189:   background-color: $data_table_dark;
1.900     bisitz   6190:   vertical-align: top;
1.347     albertel 6191: }
1.795     www      6192: 
1.425     albertel 6193: table.LC_data_table tr.LC_data_table_highlight td {
                   6194:   background-color: $data_table_darker;
                   6195: }
1.795     www      6196: 
1.639     raeburn  6197: table.LC_data_table tr td.LC_leftcol_header {
                   6198:   background-color: $data_table_head;
                   6199:   font-weight: bold;
                   6200: }
1.795     www      6201: 
1.451     albertel 6202: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  6203: table.LC_nested tr.LC_empty_row td {
1.421     albertel 6204:   font-weight: bold;
                   6205:   font-style: italic;
                   6206:   text-align: center;
                   6207:   padding: 8px;
1.347     albertel 6208: }
1.795     www      6209: 
1.1114    raeburn  6210: table.LC_data_table tr.LC_empty_row td,
                   6211: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   6212:   background-color: $sidebg;
                   6213: }
                   6214: 
                   6215: table.LC_nested tr.LC_empty_row td {
                   6216:   background-color: #FFFFFF;
                   6217: }
                   6218: 
1.890     droeschl 6219: table.LC_caption {
                   6220: }
                   6221: 
1.507     raeburn  6222: table.LC_nested tr.LC_empty_row td {
1.465     albertel 6223:   padding: 4ex
                   6224: }
1.795     www      6225: 
1.507     raeburn  6226: table.LC_nested_outer tr th {
                   6227:   font-weight: bold;
1.801     tempelho 6228:   color:$fontmenu;
1.507     raeburn  6229:   background-color: $data_table_head;
1.701     harmsja  6230:   font-size: small;
1.507     raeburn  6231:   border-bottom: 1px solid #000000;
                   6232: }
1.795     www      6233: 
1.507     raeburn  6234: table.LC_nested_outer tr td.LC_subheader {
                   6235:   background-color: $data_table_head;
                   6236:   font-weight: bold;
                   6237:   font-size: small;
                   6238:   border-bottom: 1px solid #000000;
                   6239:   text-align: right;
1.451     albertel 6240: }
1.795     www      6241: 
1.507     raeburn  6242: table.LC_nested tr.LC_info_row td {
1.735     bisitz   6243:   background-color: #CCCCCC;
1.451     albertel 6244:   font-weight: bold;
                   6245:   font-size: small;
1.507     raeburn  6246:   text-align: center;
                   6247: }
1.795     www      6248: 
1.589     raeburn  6249: table.LC_nested tr.LC_info_row td.LC_left_item,
                   6250: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  6251:   text-align: left;
1.451     albertel 6252: }
1.795     www      6253: 
1.507     raeburn  6254: table.LC_nested td {
1.735     bisitz   6255:   background-color: #FFFFFF;
1.451     albertel 6256:   font-size: small;
1.507     raeburn  6257: }
1.795     www      6258: 
1.507     raeburn  6259: table.LC_nested_outer tr th.LC_right_item,
                   6260: table.LC_nested tr.LC_info_row td.LC_right_item,
                   6261: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   6262: table.LC_nested tr td.LC_right_item {
1.451     albertel 6263:   text-align: right;
                   6264: }
                   6265: 
1.507     raeburn  6266: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   6267:   background-color: #EEEEEE;
1.451     albertel 6268: }
                   6269: 
1.473     raeburn  6270: table.LC_createuser {
                   6271: }
                   6272: 
                   6273: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  6274:   font-size: small;
1.473     raeburn  6275: }
                   6276: 
                   6277: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   6278:   background-color: #CCCCCC;
1.473     raeburn  6279:   font-weight: bold;
                   6280:   text-align: center;
                   6281: }
                   6282: 
1.349     albertel 6283: table.LC_calendar {
                   6284:   border: 1px solid #000000;
                   6285:   border-collapse: collapse;
1.917     raeburn  6286:   width: 98%;
1.349     albertel 6287: }
1.795     www      6288: 
1.349     albertel 6289: table.LC_calendar_pickdate {
                   6290:   font-size: xx-small;
                   6291: }
1.795     www      6292: 
1.349     albertel 6293: table.LC_calendar tr td {
                   6294:   border: 1px solid #000000;
                   6295:   vertical-align: top;
1.917     raeburn  6296:   width: 14%;
1.349     albertel 6297: }
1.795     www      6298: 
1.349     albertel 6299: table.LC_calendar tr td.LC_calendar_day_empty {
                   6300:   background-color: $data_table_dark;
                   6301: }
1.795     www      6302: 
1.779     bisitz   6303: table.LC_calendar tr td.LC_calendar_day_current {
                   6304:   background-color: $data_table_highlight;
1.777     tempelho 6305: }
1.795     www      6306: 
1.938     bisitz   6307: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 6308:   background-color: $mail_new;
                   6309: }
1.795     www      6310: 
1.938     bisitz   6311: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 6312:   background-color: $mail_new_hover;
                   6313: }
1.795     www      6314: 
1.938     bisitz   6315: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 6316:   background-color: $mail_read;
                   6317: }
1.795     www      6318: 
1.938     bisitz   6319: /*
                   6320: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 6321:   background-color: $mail_read_hover;
                   6322: }
1.938     bisitz   6323: */
1.795     www      6324: 
1.938     bisitz   6325: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 6326:   background-color: $mail_replied;
                   6327: }
1.795     www      6328: 
1.938     bisitz   6329: /*
                   6330: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 6331:   background-color: $mail_replied_hover;
                   6332: }
1.938     bisitz   6333: */
1.795     www      6334: 
1.938     bisitz   6335: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6336:   background-color: $mail_other;
                   6337: }
1.795     www      6338: 
1.938     bisitz   6339: /*
                   6340: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6341:   background-color: $mail_other_hover;
                   6342: }
1.938     bisitz   6343: */
1.494     raeburn  6344: 
1.777     tempelho 6345: table.LC_data_table tr > td.LC_browser_file,
                   6346: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6347:   background: #AAEE77;
1.389     albertel 6348: }
1.795     www      6349: 
1.777     tempelho 6350: table.LC_data_table tr > td.LC_browser_file_locked,
                   6351: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6352:   background: #FFAA99;
1.387     albertel 6353: }
1.795     www      6354: 
1.777     tempelho 6355: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6356:   background: #888888;
1.779     bisitz   6357: }
1.795     www      6358: 
1.777     tempelho 6359: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6360: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6361:   background: #F8F866;
1.777     tempelho 6362: }
1.795     www      6363: 
1.696     bisitz   6364: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6365:   background: #E0E8FF;
1.387     albertel 6366: }
1.696     bisitz   6367: 
1.707     bisitz   6368: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6369:   /* background: #77FF77; */
1.707     bisitz   6370: }
1.795     www      6371: 
1.707     bisitz   6372: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6373:   border-right: 8px solid #FFFF77;
1.707     bisitz   6374: }
1.795     www      6375: 
1.707     bisitz   6376: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6377:   border-right: 8px solid #FFAA77;
1.707     bisitz   6378: }
1.795     www      6379: 
1.707     bisitz   6380: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6381:   border-right: 8px solid #FF7777;
1.707     bisitz   6382: }
1.795     www      6383: 
1.707     bisitz   6384: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6385:   border-right: 8px solid #AAFF77;
1.707     bisitz   6386: }
1.795     www      6387: 
1.707     bisitz   6388: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6389:   border-right: 8px solid #11CC55;
1.707     bisitz   6390: }
                   6391: 
1.388     albertel 6392: span.LC_current_location {
1.701     harmsja  6393:   font-size:larger;
1.388     albertel 6394:   background: $pgbg;
                   6395: }
1.387     albertel 6396: 
1.1029    www      6397: span.LC_current_nav_location {
                   6398:   font-weight:bold;
                   6399:   background: $sidebg;
                   6400: }
                   6401: 
1.395     albertel 6402: span.LC_parm_menu_item {
                   6403:   font-size: larger;
                   6404: }
1.795     www      6405: 
1.395     albertel 6406: span.LC_parm_scope_all {
                   6407:   color: red;
                   6408: }
1.795     www      6409: 
1.395     albertel 6410: span.LC_parm_scope_folder {
                   6411:   color: green;
                   6412: }
1.795     www      6413: 
1.395     albertel 6414: span.LC_parm_scope_resource {
                   6415:   color: orange;
                   6416: }
1.795     www      6417: 
1.395     albertel 6418: span.LC_parm_part {
                   6419:   color: blue;
                   6420: }
1.795     www      6421: 
1.911     bisitz   6422: span.LC_parm_folder,
                   6423: span.LC_parm_symb {
1.395     albertel 6424:   font-size: x-small;
                   6425:   font-family: $mono;
                   6426:   color: #AAAAAA;
                   6427: }
                   6428: 
1.977     bisitz   6429: ul.LC_parm_parmlist li {
                   6430:   display: inline-block;
                   6431:   padding: 0.3em 0.8em;
                   6432:   vertical-align: top;
                   6433:   width: 150px;
                   6434:   border-top:1px solid $lg_border_color;
                   6435: }
                   6436: 
1.795     www      6437: td.LC_parm_overview_level_menu,
                   6438: td.LC_parm_overview_map_menu,
                   6439: td.LC_parm_overview_parm_selectors,
                   6440: td.LC_parm_overview_restrictions  {
1.396     albertel 6441:   border: 1px solid black;
                   6442:   border-collapse: collapse;
                   6443: }
1.795     www      6444: 
1.396     albertel 6445: table.LC_parm_overview_restrictions td {
                   6446:   border-width: 1px 4px 1px 4px;
                   6447:   border-style: solid;
                   6448:   border-color: $pgbg;
                   6449:   text-align: center;
                   6450: }
1.795     www      6451: 
1.396     albertel 6452: table.LC_parm_overview_restrictions th {
                   6453:   background: $tabbg;
                   6454:   border-width: 1px 4px 1px 4px;
                   6455:   border-style: solid;
                   6456:   border-color: $pgbg;
                   6457: }
1.795     www      6458: 
1.398     albertel 6459: table#LC_helpmenu {
1.803     bisitz   6460:   border: none;
1.398     albertel 6461:   height: 55px;
1.803     bisitz   6462:   border-spacing: 0;
1.398     albertel 6463: }
                   6464: 
                   6465: table#LC_helpmenu fieldset legend {
                   6466:   font-size: larger;
                   6467: }
1.795     www      6468: 
1.397     albertel 6469: table#LC_helpmenu_links {
                   6470:   width: 100%;
                   6471:   border: 1px solid black;
                   6472:   background: $pgbg;
1.803     bisitz   6473:   padding: 0;
1.397     albertel 6474:   border-spacing: 1px;
                   6475: }
1.795     www      6476: 
1.397     albertel 6477: table#LC_helpmenu_links tr td {
                   6478:   padding: 1px;
                   6479:   background: $tabbg;
1.399     albertel 6480:   text-align: center;
                   6481:   font-weight: bold;
1.397     albertel 6482: }
1.396     albertel 6483: 
1.795     www      6484: table#LC_helpmenu_links a:link,
                   6485: table#LC_helpmenu_links a:visited,
1.397     albertel 6486: table#LC_helpmenu_links a:active {
                   6487:   text-decoration: none;
                   6488:   color: $font;
                   6489: }
1.795     www      6490: 
1.397     albertel 6491: table#LC_helpmenu_links a:hover {
                   6492:   text-decoration: underline;
                   6493:   color: $vlink;
                   6494: }
1.396     albertel 6495: 
1.417     albertel 6496: .LC_chrt_popup_exists {
                   6497:   border: 1px solid #339933;
                   6498:   margin: -1px;
                   6499: }
1.795     www      6500: 
1.417     albertel 6501: .LC_chrt_popup_up {
                   6502:   border: 1px solid yellow;
                   6503:   margin: -1px;
                   6504: }
1.795     www      6505: 
1.417     albertel 6506: .LC_chrt_popup {
                   6507:   border: 1px solid #8888FF;
                   6508:   background: #CCCCFF;
                   6509: }
1.795     www      6510: 
1.421     albertel 6511: table.LC_pick_box {
                   6512:   border-collapse: separate;
                   6513:   background: white;
                   6514:   border: 1px solid black;
                   6515:   border-spacing: 1px;
                   6516: }
1.795     www      6517: 
1.421     albertel 6518: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6519:   background: $sidebg;
1.421     albertel 6520:   font-weight: bold;
1.900     bisitz   6521:   text-align: left;
1.740     bisitz   6522:   vertical-align: top;
1.421     albertel 6523:   width: 184px;
                   6524:   padding: 8px;
                   6525: }
1.795     www      6526: 
1.579     raeburn  6527: table.LC_pick_box td.LC_pick_box_value {
                   6528:   text-align: left;
                   6529:   padding: 8px;
                   6530: }
1.795     www      6531: 
1.579     raeburn  6532: table.LC_pick_box td.LC_pick_box_select {
                   6533:   text-align: left;
                   6534:   padding: 8px;
                   6535: }
1.795     www      6536: 
1.424     albertel 6537: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6538:   padding: 0;
1.421     albertel 6539:   height: 1px;
                   6540:   background: black;
                   6541: }
1.795     www      6542: 
1.421     albertel 6543: table.LC_pick_box td.LC_pick_box_submit {
                   6544:   text-align: right;
                   6545: }
1.795     www      6546: 
1.579     raeburn  6547: table.LC_pick_box td.LC_evenrow_value {
                   6548:   text-align: left;
                   6549:   padding: 8px;
                   6550:   background-color: $data_table_light;
                   6551: }
1.795     www      6552: 
1.579     raeburn  6553: table.LC_pick_box td.LC_oddrow_value {
                   6554:   text-align: left;
                   6555:   padding: 8px;
                   6556:   background-color: $data_table_light;
                   6557: }
1.795     www      6558: 
1.579     raeburn  6559: span.LC_helpform_receipt_cat {
                   6560:   font-weight: bold;
                   6561: }
1.795     www      6562: 
1.424     albertel 6563: table.LC_group_priv_box {
                   6564:   background: white;
                   6565:   border: 1px solid black;
                   6566:   border-spacing: 1px;
                   6567: }
1.795     www      6568: 
1.424     albertel 6569: table.LC_group_priv_box td.LC_pick_box_title {
                   6570:   background: $tabbg;
                   6571:   font-weight: bold;
                   6572:   text-align: right;
                   6573:   width: 184px;
                   6574: }
1.795     www      6575: 
1.424     albertel 6576: table.LC_group_priv_box td.LC_groups_fixed {
                   6577:   background: $data_table_light;
                   6578:   text-align: center;
                   6579: }
1.795     www      6580: 
1.424     albertel 6581: table.LC_group_priv_box td.LC_groups_optional {
                   6582:   background: $data_table_dark;
                   6583:   text-align: center;
                   6584: }
1.795     www      6585: 
1.424     albertel 6586: table.LC_group_priv_box td.LC_groups_functionality {
                   6587:   background: $data_table_darker;
                   6588:   text-align: center;
                   6589:   font-weight: bold;
                   6590: }
1.795     www      6591: 
1.424     albertel 6592: table.LC_group_priv td {
                   6593:   text-align: left;
1.803     bisitz   6594:   padding: 0;
1.424     albertel 6595: }
                   6596: 
                   6597: .LC_navbuttons {
                   6598:   margin: 2ex 0ex 2ex 0ex;
                   6599: }
1.795     www      6600: 
1.423     albertel 6601: .LC_topic_bar {
                   6602:   font-weight: bold;
                   6603:   background: $tabbg;
1.918     wenzelju 6604:   margin: 1em 0em 1em 2em;
1.805     bisitz   6605:   padding: 3px;
1.918     wenzelju 6606:   font-size: 1.2em;
1.423     albertel 6607: }
1.795     www      6608: 
1.423     albertel 6609: .LC_topic_bar span {
1.918     wenzelju 6610:   left: 0.5em;
                   6611:   position: absolute;
1.423     albertel 6612:   vertical-align: middle;
1.918     wenzelju 6613:   font-size: 1.2em;
1.423     albertel 6614: }
1.795     www      6615: 
1.423     albertel 6616: table.LC_course_group_status {
                   6617:   margin: 20px;
                   6618: }
1.795     www      6619: 
1.423     albertel 6620: table.LC_status_selector td {
                   6621:   vertical-align: top;
                   6622:   text-align: center;
1.424     albertel 6623:   padding: 4px;
                   6624: }
1.795     www      6625: 
1.599     albertel 6626: div.LC_feedback_link {
1.616     albertel 6627:   clear: both;
1.829     kalberla 6628:   background: $sidebg;
1.779     bisitz   6629:   width: 100%;
1.829     kalberla 6630:   padding-bottom: 10px;
                   6631:   border: 1px $tabbg solid;
1.833     kalberla 6632:   height: 22px;
                   6633:   line-height: 22px;
                   6634:   padding-top: 5px;
                   6635: }
                   6636: 
                   6637: div.LC_feedback_link img {
                   6638:   height: 22px;
1.867     kalberla 6639:   vertical-align:middle;
1.829     kalberla 6640: }
                   6641: 
1.911     bisitz   6642: div.LC_feedback_link a {
1.829     kalberla 6643:   text-decoration: none;
1.489     raeburn  6644: }
1.795     www      6645: 
1.867     kalberla 6646: div.LC_comblock {
1.911     bisitz   6647:   display:inline;
1.867     kalberla 6648:   color:$font;
                   6649:   font-size:90%;
                   6650: }
                   6651: 
                   6652: div.LC_feedback_link div.LC_comblock {
                   6653:   padding-left:5px;
                   6654: }
                   6655: 
                   6656: div.LC_feedback_link div.LC_comblock a {
                   6657:   color:$font;
                   6658: }
                   6659: 
1.489     raeburn  6660: span.LC_feedback_link {
1.858     bisitz   6661:   /* background: $feedback_link_bg; */
1.599     albertel 6662:   font-size: larger;
                   6663: }
1.795     www      6664: 
1.599     albertel 6665: span.LC_message_link {
1.858     bisitz   6666:   /* background: $feedback_link_bg; */
1.599     albertel 6667:   font-size: larger;
                   6668:   position: absolute;
                   6669:   right: 1em;
1.489     raeburn  6670: }
1.421     albertel 6671: 
1.515     albertel 6672: table.LC_prior_tries {
1.524     albertel 6673:   border: 1px solid #000000;
                   6674:   border-collapse: separate;
                   6675:   border-spacing: 1px;
1.515     albertel 6676: }
1.523     albertel 6677: 
1.515     albertel 6678: table.LC_prior_tries td {
1.524     albertel 6679:   padding: 2px;
1.515     albertel 6680: }
1.523     albertel 6681: 
                   6682: .LC_answer_correct {
1.795     www      6683:   background: lightgreen;
                   6684:   color: darkgreen;
                   6685:   padding: 6px;
1.523     albertel 6686: }
1.795     www      6687: 
1.523     albertel 6688: .LC_answer_charged_try {
1.797     www      6689:   background: #FFAAAA;
1.795     www      6690:   color: darkred;
                   6691:   padding: 6px;
1.523     albertel 6692: }
1.795     www      6693: 
1.779     bisitz   6694: .LC_answer_not_charged_try,
1.523     albertel 6695: .LC_answer_no_grade,
                   6696: .LC_answer_late {
1.795     www      6697:   background: lightyellow;
1.523     albertel 6698:   color: black;
1.795     www      6699:   padding: 6px;
1.523     albertel 6700: }
1.795     www      6701: 
1.523     albertel 6702: .LC_answer_previous {
1.795     www      6703:   background: lightblue;
                   6704:   color: darkblue;
                   6705:   padding: 6px;
1.523     albertel 6706: }
1.795     www      6707: 
1.779     bisitz   6708: .LC_answer_no_message {
1.777     tempelho 6709:   background: #FFFFFF;
                   6710:   color: black;
1.795     www      6711:   padding: 6px;
1.779     bisitz   6712: }
1.795     www      6713: 
1.779     bisitz   6714: .LC_answer_unknown {
                   6715:   background: orange;
                   6716:   color: black;
1.795     www      6717:   padding: 6px;
1.777     tempelho 6718: }
1.795     www      6719: 
1.529     albertel 6720: span.LC_prior_numerical,
                   6721: span.LC_prior_string,
                   6722: span.LC_prior_custom,
                   6723: span.LC_prior_reaction,
                   6724: span.LC_prior_math {
1.925     bisitz   6725:   font-family: $mono;
1.523     albertel 6726:   white-space: pre;
                   6727: }
                   6728: 
1.525     albertel 6729: span.LC_prior_string {
1.925     bisitz   6730:   font-family: $mono;
1.525     albertel 6731:   white-space: pre;
                   6732: }
                   6733: 
1.523     albertel 6734: table.LC_prior_option {
                   6735:   width: 100%;
                   6736:   border-collapse: collapse;
                   6737: }
1.795     www      6738: 
1.911     bisitz   6739: table.LC_prior_rank,
1.795     www      6740: table.LC_prior_match {
1.528     albertel 6741:   border-collapse: collapse;
                   6742: }
1.795     www      6743: 
1.528     albertel 6744: table.LC_prior_option tr td,
                   6745: table.LC_prior_rank tr td,
                   6746: table.LC_prior_match tr td {
1.524     albertel 6747:   border: 1px solid #000000;
1.515     albertel 6748: }
                   6749: 
1.855     bisitz   6750: .LC_nobreak {
1.544     albertel 6751:   white-space: nowrap;
1.519     raeburn  6752: }
                   6753: 
1.576     raeburn  6754: span.LC_cusr_emph {
                   6755:   font-style: italic;
                   6756: }
                   6757: 
1.633     raeburn  6758: span.LC_cusr_subheading {
                   6759:   font-weight: normal;
                   6760:   font-size: 85%;
                   6761: }
                   6762: 
1.861     bisitz   6763: div.LC_docs_entry_move {
1.859     bisitz   6764:   border: 1px solid #BBBBBB;
1.545     albertel 6765:   background: #DDDDDD;
1.861     bisitz   6766:   width: 22px;
1.859     bisitz   6767:   padding: 1px;
                   6768:   margin: 0;
1.545     albertel 6769: }
                   6770: 
1.861     bisitz   6771: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6772: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6773:   font-size: x-small;
                   6774: }
1.795     www      6775: 
1.861     bisitz   6776: .LC_docs_entry_parameter {
                   6777:   white-space: nowrap;
                   6778: }
                   6779: 
1.544     albertel 6780: .LC_docs_copy {
1.545     albertel 6781:   color: #000099;
1.544     albertel 6782: }
1.795     www      6783: 
1.544     albertel 6784: .LC_docs_cut {
1.545     albertel 6785:   color: #550044;
1.544     albertel 6786: }
1.795     www      6787: 
1.544     albertel 6788: .LC_docs_rename {
1.545     albertel 6789:   color: #009900;
1.544     albertel 6790: }
1.795     www      6791: 
1.544     albertel 6792: .LC_docs_remove {
1.545     albertel 6793:   color: #990000;
                   6794: }
                   6795: 
1.547     albertel 6796: .LC_docs_reinit_warn,
                   6797: .LC_docs_ext_edit {
                   6798:   font-size: x-small;
                   6799: }
                   6800: 
1.545     albertel 6801: table.LC_docs_adddocs td,
                   6802: table.LC_docs_adddocs th {
                   6803:   border: 1px solid #BBBBBB;
                   6804:   padding: 4px;
                   6805:   background: #DDDDDD;
1.543     albertel 6806: }
                   6807: 
1.584     albertel 6808: table.LC_sty_begin {
                   6809:   background: #BBFFBB;
                   6810: }
1.795     www      6811: 
1.584     albertel 6812: table.LC_sty_end {
                   6813:   background: #FFBBBB;
                   6814: }
                   6815: 
1.589     raeburn  6816: table.LC_double_column {
1.803     bisitz   6817:   border-width: 0;
1.589     raeburn  6818:   border-collapse: collapse;
                   6819:   width: 100%;
                   6820:   padding: 2px;
                   6821: }
                   6822: 
                   6823: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6824:   top: 2px;
1.589     raeburn  6825:   left: 2px;
                   6826:   width: 47%;
                   6827:   vertical-align: top;
                   6828: }
                   6829: 
                   6830: table.LC_double_column tr td.LC_right_col {
                   6831:   top: 2px;
1.779     bisitz   6832:   right: 2px;
1.589     raeburn  6833:   width: 47%;
                   6834:   vertical-align: top;
                   6835: }
                   6836: 
1.591     raeburn  6837: div.LC_left_float {
                   6838:   float: left;
                   6839:   padding-right: 5%;
1.597     albertel 6840:   padding-bottom: 4px;
1.591     raeburn  6841: }
                   6842: 
                   6843: div.LC_clear_float_header {
1.597     albertel 6844:   padding-bottom: 2px;
1.591     raeburn  6845: }
                   6846: 
                   6847: div.LC_clear_float_footer {
1.597     albertel 6848:   padding-top: 10px;
1.591     raeburn  6849:   clear: both;
                   6850: }
                   6851: 
1.597     albertel 6852: div.LC_grade_show_user {
1.941     bisitz   6853: /*  border-left: 5px solid $sidebg; */
                   6854:   border-top: 5px solid #000000;
                   6855:   margin: 50px 0 0 0;
1.936     bisitz   6856:   padding: 15px 0 5px 10px;
1.597     albertel 6857: }
1.795     www      6858: 
1.936     bisitz   6859: div.LC_grade_show_user_odd_row {
1.941     bisitz   6860: /*  border-left: 5px solid #000000; */
                   6861: }
                   6862: 
                   6863: div.LC_grade_show_user div.LC_Box {
                   6864:   margin-right: 50px;
1.597     albertel 6865: }
                   6866: 
                   6867: div.LC_grade_submissions,
                   6868: div.LC_grade_message_center,
1.936     bisitz   6869: div.LC_grade_info_links {
1.597     albertel 6870:   margin: 5px;
                   6871:   width: 99%;
                   6872:   background: #FFFFFF;
                   6873: }
1.795     www      6874: 
1.597     albertel 6875: div.LC_grade_submissions_header,
1.936     bisitz   6876: div.LC_grade_message_center_header {
1.705     tempelho 6877:   font-weight: bold;
                   6878:   font-size: large;
1.597     albertel 6879: }
1.795     www      6880: 
1.597     albertel 6881: div.LC_grade_submissions_body,
1.936     bisitz   6882: div.LC_grade_message_center_body {
1.597     albertel 6883:   border: 1px solid black;
                   6884:   width: 99%;
                   6885:   background: #FFFFFF;
                   6886: }
1.795     www      6887: 
1.613     albertel 6888: table.LC_scantron_action {
                   6889:   width: 100%;
                   6890: }
1.795     www      6891: 
1.613     albertel 6892: table.LC_scantron_action tr th {
1.698     harmsja  6893:   font-weight:bold;
                   6894:   font-style:normal;
1.613     albertel 6895: }
1.795     www      6896: 
1.779     bisitz   6897: .LC_edit_problem_header,
1.614     albertel 6898: div.LC_edit_problem_footer {
1.705     tempelho 6899:   font-weight: normal;
                   6900:   font-size:  medium;
1.602     albertel 6901:   margin: 2px;
1.1060    bisitz   6902:   background-color: $sidebg;
1.600     albertel 6903: }
1.795     www      6904: 
1.600     albertel 6905: div.LC_edit_problem_header,
1.602     albertel 6906: div.LC_edit_problem_header div,
1.614     albertel 6907: div.LC_edit_problem_footer,
                   6908: div.LC_edit_problem_footer div,
1.602     albertel 6909: div.LC_edit_problem_editxml_header,
                   6910: div.LC_edit_problem_editxml_header div {
1.1205    golterma 6911:   z-index: 100;
1.600     albertel 6912: }
1.795     www      6913: 
1.600     albertel 6914: div.LC_edit_problem_header_title {
1.705     tempelho 6915:   font-weight: bold;
                   6916:   font-size: larger;
1.602     albertel 6917:   background: $tabbg;
                   6918:   padding: 3px;
1.1060    bisitz   6919:   margin: 0 0 5px 0;
1.602     albertel 6920: }
1.795     www      6921: 
1.602     albertel 6922: table.LC_edit_problem_header_title {
                   6923:   width: 100%;
1.600     albertel 6924:   background: $tabbg;
1.602     albertel 6925: }
                   6926: 
1.1205    golterma 6927: div.LC_edit_actionbar {
                   6928:     background-color: $sidebg;
1.1218    droeschl 6929:     margin: 0;
                   6930:     padding: 0;
                   6931:     line-height: 200%;
1.602     albertel 6932: }
1.795     www      6933: 
1.1218    droeschl 6934: div.LC_edit_actionbar div{
                   6935:     padding: 0;
                   6936:     margin: 0;
                   6937:     display: inline-block;
1.600     albertel 6938: }
1.795     www      6939: 
1.1124    bisitz   6940: .LC_edit_opt {
                   6941:   padding-left: 1em;
                   6942:   white-space: nowrap;
                   6943: }
                   6944: 
1.1152    golterma 6945: .LC_edit_problem_latexhelper{
                   6946:     text-align: right;
                   6947: }
                   6948: 
                   6949: #LC_edit_problem_colorful div{
                   6950:     margin-left: 40px;
                   6951: }
                   6952: 
1.1205    golterma 6953: #LC_edit_problem_codemirror div{
                   6954:     margin-left: 0px;
                   6955: }
                   6956: 
1.911     bisitz   6957: img.stift {
1.803     bisitz   6958:   border-width: 0;
                   6959:   vertical-align: middle;
1.677     riegler  6960: }
1.680     riegler  6961: 
1.923     bisitz   6962: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6963:   vertical-align: top;
1.777     tempelho 6964: }
1.795     www      6965: 
1.716     raeburn  6966: div.LC_createcourse {
1.911     bisitz   6967:   margin: 10px 10px 10px 10px;
1.716     raeburn  6968: }
                   6969: 
1.917     raeburn  6970: .LC_dccid {
1.1130    raeburn  6971:   float: right;
1.917     raeburn  6972:   margin: 0.2em 0 0 0;
                   6973:   padding: 0;
                   6974:   font-size: 90%;
                   6975:   display:none;
                   6976: }
                   6977: 
1.897     wenzelju 6978: ol.LC_primary_menu a:hover,
1.721     harmsja  6979: ol#LC_MenuBreadcrumbs a:hover,
                   6980: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6981: ul#LC_secondary_menu a:hover,
1.721     harmsja  6982: .LC_FormSectionClearButton input:hover
1.795     www      6983: ul.LC_TabContent   li:hover a {
1.952     onken    6984:   color:$button_hover;
1.911     bisitz   6985:   text-decoration:none;
1.693     droeschl 6986: }
                   6987: 
1.779     bisitz   6988: h1 {
1.911     bisitz   6989:   padding: 0;
                   6990:   line-height:130%;
1.693     droeschl 6991: }
1.698     harmsja  6992: 
1.911     bisitz   6993: h2,
                   6994: h3,
                   6995: h4,
                   6996: h5,
                   6997: h6 {
                   6998:   margin: 5px 0 5px 0;
                   6999:   padding: 0;
                   7000:   line-height:130%;
1.693     droeschl 7001: }
1.795     www      7002: 
                   7003: .LC_hcell {
1.911     bisitz   7004:   padding:3px 15px 3px 15px;
                   7005:   margin: 0;
                   7006:   background-color:$tabbg;
                   7007:   color:$fontmenu;
                   7008:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 7009: }
1.795     www      7010: 
1.840     bisitz   7011: .LC_Box > .LC_hcell {
1.911     bisitz   7012:   margin: 0 -10px 10px -10px;
1.835     bisitz   7013: }
                   7014: 
1.721     harmsja  7015: .LC_noBorder {
1.911     bisitz   7016:   border: 0;
1.698     harmsja  7017: }
1.693     droeschl 7018: 
1.721     harmsja  7019: .LC_FormSectionClearButton input {
1.911     bisitz   7020:   background-color:transparent;
                   7021:   border: none;
                   7022:   cursor:pointer;
                   7023:   text-decoration:underline;
1.693     droeschl 7024: }
1.763     bisitz   7025: 
                   7026: .LC_help_open_topic {
1.911     bisitz   7027:   color: #FFFFFF;
                   7028:   background-color: #EEEEFF;
                   7029:   margin: 1px;
                   7030:   padding: 4px;
                   7031:   border: 1px solid #000033;
                   7032:   white-space: nowrap;
                   7033:   /* vertical-align: middle; */
1.759     neumanie 7034: }
1.693     droeschl 7035: 
1.911     bisitz   7036: dl,
                   7037: ul,
                   7038: div,
                   7039: fieldset {
                   7040:   margin: 10px 10px 10px 0;
                   7041:   /* overflow: hidden; */
1.693     droeschl 7042: }
1.795     www      7043: 
1.1211    raeburn  7044: article.geogebraweb div {
                   7045:     margin: 0;
                   7046: }
                   7047: 
1.838     bisitz   7048: fieldset > legend {
1.911     bisitz   7049:   font-weight: bold;
                   7050:   padding: 0 5px 0 5px;
1.838     bisitz   7051: }
                   7052: 
1.813     bisitz   7053: #LC_nav_bar {
1.911     bisitz   7054:   float: left;
1.995     raeburn  7055:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   7056:   margin: 0 0 2px 0;
1.807     droeschl 7057: }
                   7058: 
1.916     droeschl 7059: #LC_realm {
                   7060:   margin: 0.2em 0 0 0;
                   7061:   padding: 0;
                   7062:   font-weight: bold;
                   7063:   text-align: center;
1.995     raeburn  7064:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7065: }
                   7066: 
1.911     bisitz   7067: #LC_nav_bar em {
                   7068:   font-weight: bold;
                   7069:   font-style: normal;
1.807     droeschl 7070: }
                   7071: 
1.897     wenzelju 7072: ol.LC_primary_menu {
1.934     droeschl 7073:   margin: 0;
1.1076    raeburn  7074:   padding: 0;
1.807     droeschl 7075: }
                   7076: 
1.852     droeschl 7077: ol#LC_PathBreadcrumbs {
1.911     bisitz   7078:   margin: 0;
1.693     droeschl 7079: }
                   7080: 
1.897     wenzelju 7081: ol.LC_primary_menu li {
1.1076    raeburn  7082:   color: RGB(80, 80, 80);
                   7083:   vertical-align: middle;
                   7084:   text-align: left;
                   7085:   list-style: none;
1.1205    golterma 7086:   position: relative;
1.1076    raeburn  7087:   float: left;
1.1205    golterma 7088:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7089:   line-height: 1.5em;
1.1076    raeburn  7090: }
                   7091: 
1.1205    golterma 7092: ol.LC_primary_menu li a,
                   7093: ol.LC_primary_menu li p {
1.1076    raeburn  7094:   display: block;
                   7095:   margin: 0;
                   7096:   padding: 0 5px 0 10px;
                   7097:   text-decoration: none;
                   7098: }
                   7099: 
1.1205    golterma 7100: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   7101:   display: inline-block;
                   7102:   width: 95%;
                   7103:   text-align: left;
                   7104: }
                   7105: 
                   7106: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   7107:   display: inline-block;	
                   7108:   width: 5%;
                   7109:   float: right;
                   7110:   text-align: right;
                   7111:   font-size: 70%;
                   7112: }
                   7113: 
                   7114: ol.LC_primary_menu ul {
1.1076    raeburn  7115:   display: none;
1.1205    golterma 7116:   width: 15em;
1.1076    raeburn  7117:   background-color: $data_table_light;
1.1205    golterma 7118:   position: absolute;
                   7119:   top: 100%;
1.1076    raeburn  7120: }
                   7121: 
1.1205    golterma 7122: ol.LC_primary_menu ul ul {
                   7123:   left: 100%;
                   7124:   top: 0;
                   7125: }
                   7126: 
                   7127: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076    raeburn  7128:   display: block;
                   7129:   position: absolute;
                   7130:   margin: 0;
                   7131:   padding: 0;
1.1078    raeburn  7132:   z-index: 2;
1.1076    raeburn  7133: }
                   7134: 
                   7135: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205    golterma 7136: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076    raeburn  7137:   font-size: 90%;
1.911     bisitz   7138:   vertical-align: top;
1.1076    raeburn  7139:   float: none;
1.1079    raeburn  7140:   border-left: 1px solid black;
                   7141:   border-right: 1px solid black;
1.1205    golterma 7142: /* A dark bottom border to visualize different menu options; 
                   7143: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   7144:   border-bottom: 1px solid $data_table_dark; 
1.1076    raeburn  7145: }
                   7146: 
1.1205    golterma 7147: ol.LC_primary_menu li li p:hover {
                   7148:   color:$button_hover;
                   7149:   text-decoration:none;
                   7150:   background-color:$data_table_dark;
1.1076    raeburn  7151: }
                   7152: 
                   7153: ol.LC_primary_menu li li a:hover {
                   7154:    color:$button_hover;
                   7155:    background-color:$data_table_dark;
1.693     droeschl 7156: }
                   7157: 
1.1205    golterma 7158: /* Font-size equal to the size of the predecessors*/
                   7159: ol.LC_primary_menu li:hover li li {
                   7160:   font-size: 100%;
                   7161: }
                   7162: 
1.897     wenzelju 7163: ol.LC_primary_menu li img {
1.911     bisitz   7164:   vertical-align: bottom;
1.934     droeschl 7165:   height: 1.1em;
1.1077    raeburn  7166:   margin: 0.2em 0 0 0;
1.693     droeschl 7167: }
                   7168: 
1.897     wenzelju 7169: ol.LC_primary_menu a {
1.911     bisitz   7170:   color: RGB(80, 80, 80);
                   7171:   text-decoration: none;
1.693     droeschl 7172: }
1.795     www      7173: 
1.949     droeschl 7174: ol.LC_primary_menu a.LC_new_message {
                   7175:   font-weight:bold;
                   7176:   color: darkred;
                   7177: }
                   7178: 
1.975     raeburn  7179: ol.LC_docs_parameters {
                   7180:   margin-left: 0;
                   7181:   padding: 0;
                   7182:   list-style: none;
                   7183: }
                   7184: 
                   7185: ol.LC_docs_parameters li {
                   7186:   margin: 0;
                   7187:   padding-right: 20px;
                   7188:   display: inline;
                   7189: }
                   7190: 
1.976     raeburn  7191: ol.LC_docs_parameters li:before {
                   7192:   content: "\\002022 \\0020";
                   7193: }
                   7194: 
                   7195: li.LC_docs_parameters_title {
                   7196:   font-weight: bold;
                   7197: }
                   7198: 
                   7199: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   7200:   content: "";
                   7201: }
                   7202: 
1.897     wenzelju 7203: ul#LC_secondary_menu {
1.1107    raeburn  7204:   clear: right;
1.911     bisitz   7205:   color: $fontmenu;
                   7206:   background: $tabbg;
                   7207:   list-style: none;
                   7208:   padding: 0;
                   7209:   margin: 0;
                   7210:   width: 100%;
1.995     raeburn  7211:   text-align: left;
1.1107    raeburn  7212:   float: left;
1.808     droeschl 7213: }
                   7214: 
1.897     wenzelju 7215: ul#LC_secondary_menu li {
1.911     bisitz   7216:   font-weight: bold;
                   7217:   line-height: 1.8em;
1.1107    raeburn  7218:   border-right: 1px solid black;
                   7219:   float: left;
                   7220: }
                   7221: 
                   7222: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   7223:   background-color: $data_table_light;
                   7224: }
                   7225: 
                   7226: ul#LC_secondary_menu li a {
1.911     bisitz   7227:   padding: 0 0.8em;
1.1107    raeburn  7228: }
                   7229: 
                   7230: ul#LC_secondary_menu li ul {
                   7231:   display: none;
                   7232: }
                   7233: 
                   7234: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   7235:   display: block;
                   7236:   position: absolute;
                   7237:   margin: 0;
                   7238:   padding: 0;
                   7239:   list-style:none;
                   7240:   float: none;
                   7241:   background-color: $data_table_light;
                   7242:   z-index: 2;
                   7243:   margin-left: -1px;
                   7244: }
                   7245: 
                   7246: ul#LC_secondary_menu li ul li {
                   7247:   font-size: 90%;
                   7248:   vertical-align: top;
                   7249:   border-left: 1px solid black;
1.911     bisitz   7250:   border-right: 1px solid black;
1.1119    raeburn  7251:   background-color: $data_table_light;
1.1107    raeburn  7252:   list-style:none;
                   7253:   float: none;
                   7254: }
                   7255: 
                   7256: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   7257:   background-color: $data_table_dark;
1.807     droeschl 7258: }
                   7259: 
1.847     tempelho 7260: ul.LC_TabContent {
1.911     bisitz   7261:   display:block;
                   7262:   background: $sidebg;
                   7263:   border-bottom: solid 1px $lg_border_color;
                   7264:   list-style:none;
1.1020    raeburn  7265:   margin: -1px -10px 0 -10px;
1.911     bisitz   7266:   padding: 0;
1.693     droeschl 7267: }
                   7268: 
1.795     www      7269: ul.LC_TabContent li,
                   7270: ul.LC_TabContentBigger li {
1.911     bisitz   7271:   float:left;
1.741     harmsja  7272: }
1.795     www      7273: 
1.897     wenzelju 7274: ul#LC_secondary_menu li a {
1.911     bisitz   7275:   color: $fontmenu;
                   7276:   text-decoration: none;
1.693     droeschl 7277: }
1.795     www      7278: 
1.721     harmsja  7279: ul.LC_TabContent {
1.952     onken    7280:   min-height:20px;
1.721     harmsja  7281: }
1.795     www      7282: 
                   7283: ul.LC_TabContent li {
1.911     bisitz   7284:   vertical-align:middle;
1.959     onken    7285:   padding: 0 16px 0 10px;
1.911     bisitz   7286:   background-color:$tabbg;
                   7287:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  7288:   border-left: solid 1px $font;
1.721     harmsja  7289: }
1.795     www      7290: 
1.847     tempelho 7291: ul.LC_TabContent .right {
1.911     bisitz   7292:   float:right;
1.847     tempelho 7293: }
                   7294: 
1.911     bisitz   7295: ul.LC_TabContent li a,
                   7296: ul.LC_TabContent li {
                   7297:   color:rgb(47,47,47);
                   7298:   text-decoration:none;
                   7299:   font-size:95%;
                   7300:   font-weight:bold;
1.952     onken    7301:   min-height:20px;
                   7302: }
                   7303: 
1.959     onken    7304: ul.LC_TabContent li a:hover,
                   7305: ul.LC_TabContent li a:focus {
1.952     onken    7306:   color: $button_hover;
1.959     onken    7307:   background:none;
                   7308:   outline:none;
1.952     onken    7309: }
                   7310: 
                   7311: ul.LC_TabContent li:hover {
                   7312:   color: $button_hover;
                   7313:   cursor:pointer;
1.721     harmsja  7314: }
1.795     www      7315: 
1.911     bisitz   7316: ul.LC_TabContent li.active {
1.952     onken    7317:   color: $font;
1.911     bisitz   7318:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    7319:   border-bottom:solid 1px #FFFFFF;
                   7320:   cursor: default;
1.744     ehlerst  7321: }
1.795     www      7322: 
1.959     onken    7323: ul.LC_TabContent li.active a {
                   7324:   color:$font;
                   7325:   background:#FFFFFF;
                   7326:   outline: none;
                   7327: }
1.1047    raeburn  7328: 
                   7329: ul.LC_TabContent li.goback {
                   7330:   float: left;
                   7331:   border-left: none;
                   7332: }
                   7333: 
1.870     tempelho 7334: #maincoursedoc {
1.911     bisitz   7335:   clear:both;
1.870     tempelho 7336: }
                   7337: 
                   7338: ul.LC_TabContentBigger {
1.911     bisitz   7339:   display:block;
                   7340:   list-style:none;
                   7341:   padding: 0;
1.870     tempelho 7342: }
                   7343: 
1.795     www      7344: ul.LC_TabContentBigger li {
1.911     bisitz   7345:   vertical-align:bottom;
                   7346:   height: 30px;
                   7347:   font-size:110%;
                   7348:   font-weight:bold;
                   7349:   color: #737373;
1.841     tempelho 7350: }
                   7351: 
1.957     onken    7352: ul.LC_TabContentBigger li.active {
                   7353:   position: relative;
                   7354:   top: 1px;
                   7355: }
                   7356: 
1.870     tempelho 7357: ul.LC_TabContentBigger li a {
1.911     bisitz   7358:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   7359:   height: 30px;
                   7360:   line-height: 30px;
                   7361:   text-align: center;
                   7362:   display: block;
                   7363:   text-decoration: none;
1.958     onken    7364:   outline: none;  
1.741     harmsja  7365: }
1.795     www      7366: 
1.870     tempelho 7367: ul.LC_TabContentBigger li.active a {
1.911     bisitz   7368:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   7369:   color:$font;
1.744     ehlerst  7370: }
1.795     www      7371: 
1.870     tempelho 7372: ul.LC_TabContentBigger li b {
1.911     bisitz   7373:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7374:   display: block;
                   7375:   float: left;
                   7376:   padding: 0 30px;
1.957     onken    7377:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7378: }
                   7379: 
1.956     onken    7380: ul.LC_TabContentBigger li:hover b {
                   7381:   color:$button_hover;
                   7382: }
                   7383: 
1.870     tempelho 7384: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7385:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7386:   color:$font;
1.957     onken    7387:   border: 0;
1.741     harmsja  7388: }
1.693     droeschl 7389: 
1.870     tempelho 7390: 
1.862     bisitz   7391: ul.LC_CourseBreadcrumbs {
                   7392:   background: $sidebg;
1.1020    raeburn  7393:   height: 2em;
1.862     bisitz   7394:   padding-left: 10px;
1.1020    raeburn  7395:   margin: 0;
1.862     bisitz   7396:   list-style-position: inside;
                   7397: }
                   7398: 
1.911     bisitz   7399: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7400: ol#LC_PathBreadcrumbs {
1.911     bisitz   7401:   padding-left: 10px;
                   7402:   margin: 0;
1.933     droeschl 7403:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7404: }
                   7405: 
1.911     bisitz   7406: ol#LC_MenuBreadcrumbs li,
                   7407: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7408: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7409:   display: inline;
1.933     droeschl 7410:   white-space: normal;  
1.693     droeschl 7411: }
                   7412: 
1.823     bisitz   7413: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7414: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7415:   text-decoration: none;
                   7416:   font-size:90%;
1.693     droeschl 7417: }
1.795     www      7418: 
1.969     droeschl 7419: ol#LC_MenuBreadcrumbs h1 {
                   7420:   display: inline;
                   7421:   font-size: 90%;
                   7422:   line-height: 2.5em;
                   7423:   margin: 0;
                   7424:   padding: 0;
                   7425: }
                   7426: 
1.795     www      7427: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7428:   text-decoration:none;
                   7429:   font-size:100%;
                   7430:   font-weight:bold;
1.693     droeschl 7431: }
1.795     www      7432: 
1.840     bisitz   7433: .LC_Box {
1.911     bisitz   7434:   border: solid 1px $lg_border_color;
                   7435:   padding: 0 10px 10px 10px;
1.746     neumanie 7436: }
1.795     www      7437: 
1.1020    raeburn  7438: .LC_DocsBox {
                   7439:   border: solid 1px $lg_border_color;
                   7440:   padding: 0 0 10px 10px;
                   7441: }
                   7442: 
1.795     www      7443: .LC_AboutMe_Image {
1.911     bisitz   7444:   float:left;
                   7445:   margin-right:10px;
1.747     neumanie 7446: }
1.795     www      7447: 
                   7448: .LC_Clear_AboutMe_Image {
1.911     bisitz   7449:   clear:left;
1.747     neumanie 7450: }
1.795     www      7451: 
1.721     harmsja  7452: dl.LC_ListStyleClean dt {
1.911     bisitz   7453:   padding-right: 5px;
                   7454:   display: table-header-group;
1.693     droeschl 7455: }
                   7456: 
1.721     harmsja  7457: dl.LC_ListStyleClean dd {
1.911     bisitz   7458:   display: table-row;
1.693     droeschl 7459: }
                   7460: 
1.721     harmsja  7461: .LC_ListStyleClean,
                   7462: .LC_ListStyleSimple,
                   7463: .LC_ListStyleNormal,
1.795     www      7464: .LC_ListStyleSpecial {
1.911     bisitz   7465:   /* display:block; */
                   7466:   list-style-position: inside;
                   7467:   list-style-type: none;
                   7468:   overflow: hidden;
                   7469:   padding: 0;
1.693     droeschl 7470: }
                   7471: 
1.721     harmsja  7472: .LC_ListStyleSimple li,
                   7473: .LC_ListStyleSimple dd,
                   7474: .LC_ListStyleNormal li,
                   7475: .LC_ListStyleNormal dd,
                   7476: .LC_ListStyleSpecial li,
1.795     www      7477: .LC_ListStyleSpecial dd {
1.911     bisitz   7478:   margin: 0;
                   7479:   padding: 5px 5px 5px 10px;
                   7480:   clear: both;
1.693     droeschl 7481: }
                   7482: 
1.721     harmsja  7483: .LC_ListStyleClean li,
                   7484: .LC_ListStyleClean dd {
1.911     bisitz   7485:   padding-top: 0;
                   7486:   padding-bottom: 0;
1.693     droeschl 7487: }
                   7488: 
1.721     harmsja  7489: .LC_ListStyleSimple dd,
1.795     www      7490: .LC_ListStyleSimple li {
1.911     bisitz   7491:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7492: }
                   7493: 
1.721     harmsja  7494: .LC_ListStyleSpecial li,
                   7495: .LC_ListStyleSpecial dd {
1.911     bisitz   7496:   list-style-type: none;
                   7497:   background-color: RGB(220, 220, 220);
                   7498:   margin-bottom: 4px;
1.693     droeschl 7499: }
                   7500: 
1.721     harmsja  7501: table.LC_SimpleTable {
1.911     bisitz   7502:   margin:5px;
                   7503:   border:solid 1px $lg_border_color;
1.795     www      7504: }
1.693     droeschl 7505: 
1.721     harmsja  7506: table.LC_SimpleTable tr {
1.911     bisitz   7507:   padding: 0;
                   7508:   border:solid 1px $lg_border_color;
1.693     droeschl 7509: }
1.795     www      7510: 
                   7511: table.LC_SimpleTable thead {
1.911     bisitz   7512:   background:rgb(220,220,220);
1.693     droeschl 7513: }
                   7514: 
1.721     harmsja  7515: div.LC_columnSection {
1.911     bisitz   7516:   display: block;
                   7517:   clear: both;
                   7518:   overflow: hidden;
                   7519:   margin: 0;
1.693     droeschl 7520: }
                   7521: 
1.721     harmsja  7522: div.LC_columnSection>* {
1.911     bisitz   7523:   float: left;
                   7524:   margin: 10px 20px 10px 0;
                   7525:   overflow:hidden;
1.693     droeschl 7526: }
1.721     harmsja  7527: 
1.795     www      7528: table em {
1.911     bisitz   7529:   font-weight: bold;
                   7530:   font-style: normal;
1.748     schulted 7531: }
1.795     www      7532: 
1.779     bisitz   7533: table.LC_tableBrowseRes,
1.795     www      7534: table.LC_tableOfContent {
1.911     bisitz   7535:   border:none;
                   7536:   border-spacing: 1px;
                   7537:   padding: 3px;
                   7538:   background-color: #FFFFFF;
                   7539:   font-size: 90%;
1.753     droeschl 7540: }
1.789     droeschl 7541: 
1.911     bisitz   7542: table.LC_tableOfContent {
                   7543:   border-collapse: collapse;
1.789     droeschl 7544: }
                   7545: 
1.771     droeschl 7546: table.LC_tableBrowseRes a,
1.768     schulted 7547: table.LC_tableOfContent a {
1.911     bisitz   7548:   background-color: transparent;
                   7549:   text-decoration: none;
1.753     droeschl 7550: }
                   7551: 
1.795     www      7552: table.LC_tableOfContent img {
1.911     bisitz   7553:   border: none;
                   7554:   height: 1.3em;
                   7555:   vertical-align: text-bottom;
                   7556:   margin-right: 0.3em;
1.753     droeschl 7557: }
1.757     schulted 7558: 
1.795     www      7559: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7560:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7561: }
                   7562: 
1.795     www      7563: a#LC_content_toolbar_everything {
1.911     bisitz   7564:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7565: }
                   7566: 
1.795     www      7567: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7568:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7569: }
                   7570: 
1.795     www      7571: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7572:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7573: }
                   7574: 
1.795     www      7575: a#LC_content_toolbar_changefolder {
1.911     bisitz   7576:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7577: }
                   7578: 
1.795     www      7579: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7580:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7581: }
                   7582: 
1.1043    raeburn  7583: a#LC_content_toolbar_edittoplevel {
                   7584:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7585: }
                   7586: 
1.795     www      7587: ul#LC_toolbar li a:hover {
1.911     bisitz   7588:   background-position: bottom center;
1.757     schulted 7589: }
                   7590: 
1.795     www      7591: ul#LC_toolbar {
1.911     bisitz   7592:   padding: 0;
                   7593:   margin: 2px;
                   7594:   list-style:none;
                   7595:   position:relative;
                   7596:   background-color:white;
1.1082    raeburn  7597:   overflow: auto;
1.757     schulted 7598: }
                   7599: 
1.795     www      7600: ul#LC_toolbar li {
1.911     bisitz   7601:   border:1px solid white;
                   7602:   padding: 0;
                   7603:   margin: 0;
                   7604:   float: left;
                   7605:   display:inline;
                   7606:   vertical-align:middle;
1.1082    raeburn  7607:   white-space: nowrap;
1.911     bisitz   7608: }
1.757     schulted 7609: 
1.783     amueller 7610: 
1.795     www      7611: a.LC_toolbarItem {
1.911     bisitz   7612:   display:block;
                   7613:   padding: 0;
                   7614:   margin: 0;
                   7615:   height: 32px;
                   7616:   width: 32px;
                   7617:   color:white;
                   7618:   border: none;
                   7619:   background-repeat:no-repeat;
                   7620:   background-color:transparent;
1.757     schulted 7621: }
                   7622: 
1.915     droeschl 7623: ul.LC_funclist {
                   7624:     margin: 0;
                   7625:     padding: 0.5em 1em 0.5em 0;
                   7626: }
                   7627: 
1.933     droeschl 7628: ul.LC_funclist > li:first-child {
                   7629:     font-weight:bold; 
                   7630:     margin-left:0.8em;
                   7631: }
                   7632: 
1.915     droeschl 7633: ul.LC_funclist + ul.LC_funclist {
                   7634:     /* 
                   7635:        left border as a seperator if we have more than
                   7636:        one list 
                   7637:     */
                   7638:     border-left: 1px solid $sidebg;
                   7639:     /* 
                   7640:        this hides the left border behind the border of the 
                   7641:        outer box if element is wrapped to the next 'line' 
                   7642:     */
                   7643:     margin-left: -1px;
                   7644: }
                   7645: 
1.843     bisitz   7646: ul.LC_funclist li {
1.915     droeschl 7647:   display: inline;
1.782     bisitz   7648:   white-space: nowrap;
1.915     droeschl 7649:   margin: 0 0 0 25px;
                   7650:   line-height: 150%;
1.782     bisitz   7651: }
                   7652: 
1.974     wenzelju 7653: .LC_hidden {
                   7654:   display: none;
                   7655: }
                   7656: 
1.1030    www      7657: .LCmodal-overlay {
                   7658: 		position:fixed;
                   7659: 		top:0;
                   7660: 		right:0;
                   7661: 		bottom:0;
                   7662: 		left:0;
                   7663: 		height:100%;
                   7664: 		width:100%;
                   7665: 		margin:0;
                   7666: 		padding:0;
                   7667: 		background:#999;
                   7668: 		opacity:.75;
                   7669: 		filter: alpha(opacity=75);
                   7670: 		-moz-opacity: 0.75;
                   7671: 		z-index:101;
                   7672: }
                   7673: 
                   7674: * html .LCmodal-overlay {   
                   7675: 		position: absolute;
                   7676: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7677: }
                   7678: 
                   7679: .LCmodal-window {
                   7680: 		position:fixed;
                   7681: 		top:50%;
                   7682: 		left:50%;
                   7683: 		margin:0;
                   7684: 		padding:0;
                   7685: 		z-index:102;
                   7686: 	}
                   7687: 
                   7688: * html .LCmodal-window {
                   7689: 		position:absolute;
                   7690: }
                   7691: 
                   7692: .LCclose-window {
                   7693: 		position:absolute;
                   7694: 		width:32px;
                   7695: 		height:32px;
                   7696: 		right:8px;
                   7697: 		top:8px;
                   7698: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7699: 		text-indent:-99999px;
                   7700: 		overflow:hidden;
                   7701: 		cursor:pointer;
                   7702: }
                   7703: 
1.1100    raeburn  7704: /*
1.1231    damieng  7705:   styles used for response display
                   7706: */
                   7707: div.LC_radiofoil, div.LC_rankfoil {
                   7708:   margin: .5em 0em .5em 0em;
                   7709: }
                   7710: table.LC_itemgroup {
                   7711:   margin-top: 1em;
                   7712: }
                   7713: 
                   7714: /*
1.1100    raeburn  7715:   styles used by TTH when "Default set of options to pass to tth/m
                   7716:   when converting TeX" in course settings has been set
                   7717: 
                   7718:   option passed: -t
                   7719: 
                   7720: */
                   7721: 
                   7722: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7723: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7724: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7725: td div.norm {line-height:normal;}
                   7726: 
                   7727: /*
                   7728:   option passed -y3
                   7729: */
                   7730: 
                   7731: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7732: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7733: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7734: 
1.1230    damieng  7735: /*
                   7736:   sections with roles, for content only
                   7737: */
                   7738: section[class^="role-"] {
                   7739:   padding-left: 10px;
                   7740:   padding-right: 5px;
                   7741:   margin-top: 8px;
                   7742:   margin-bottom: 8px;
                   7743:   border: 1px solid #2A4;
                   7744:   border-radius: 5px;
                   7745:   box-shadow: 0px 1px 1px #BBB;
                   7746: }
                   7747: section[class^="role-"]>h1 {
                   7748:   position: relative;
                   7749:   margin: 0px;
                   7750:   padding-top: 10px;
                   7751:   padding-left: 40px;
                   7752: }
                   7753: section[class^="role-"]>h1:before {
                   7754:   position: absolute;
                   7755:   left: -5px;
                   7756:   top: 5px;
                   7757: }
                   7758: section.role-activity>h1:before {
                   7759:   content:url('/adm/daxe/images/section_icons/activity.png');
                   7760: }
                   7761: section.role-advice>h1:before {
                   7762:   content:url('/adm/daxe/images/section_icons/advice.png');
                   7763: }
                   7764: section.role-bibliography>h1:before {
                   7765:   content:url('/adm/daxe/images/section_icons/bibliography.png');
                   7766: }
                   7767: section.role-citation>h1:before {
                   7768:   content:url('/adm/daxe/images/section_icons/citation.png');
                   7769: }
                   7770: section.role-conclusion>h1:before {
                   7771:   content:url('/adm/daxe/images/section_icons/conclusion.png');
                   7772: }
                   7773: section.role-definition>h1:before {
                   7774:   content:url('/adm/daxe/images/section_icons/definition.png');
                   7775: }
                   7776: section.role-demonstration>h1:before {
                   7777:   content:url('/adm/daxe/images/section_icons/demonstration.png');
                   7778: }
                   7779: section.role-example>h1:before {
                   7780:   content:url('/adm/daxe/images/section_icons/example.png');
                   7781: }
                   7782: section.role-explanation>h1:before {
                   7783:   content:url('/adm/daxe/images/section_icons/explanation.png');
                   7784: }
                   7785: section.role-introduction>h1:before {
                   7786:   content:url('/adm/daxe/images/section_icons/introduction.png');
                   7787: }
                   7788: section.role-method>h1:before {
                   7789:   content:url('/adm/daxe/images/section_icons/method.png');
                   7790: }
                   7791: section.role-more_information>h1:before {
                   7792:   content:url('/adm/daxe/images/section_icons/more_information.png');
                   7793: }
                   7794: section.role-objectives>h1:before {
                   7795:   content:url('/adm/daxe/images/section_icons/objectives.png');
                   7796: }
                   7797: section.role-prerequisites>h1:before {
                   7798:   content:url('/adm/daxe/images/section_icons/prerequisites.png');
                   7799: }
                   7800: section.role-remark>h1:before {
                   7801:   content:url('/adm/daxe/images/section_icons/remark.png');
                   7802: }
                   7803: section.role-reminder>h1:before {
                   7804:   content:url('/adm/daxe/images/section_icons/reminder.png');
                   7805: }
                   7806: section.role-summary>h1:before {
                   7807:   content:url('/adm/daxe/images/section_icons/summary.png');
                   7808: }
                   7809: section.role-syntax>h1:before {
                   7810:   content:url('/adm/daxe/images/section_icons/syntax.png');
                   7811: }
                   7812: section.role-warning>h1:before {
                   7813:   content:url('/adm/daxe/images/section_icons/warning.png');
                   7814: }
                   7815: 
1.343     albertel 7816: END
                   7817: }
                   7818: 
1.306     albertel 7819: =pod
                   7820: 
                   7821: =item * &headtag()
                   7822: 
                   7823: Returns a uniform footer for LON-CAPA web pages.
                   7824: 
1.307     albertel 7825: Inputs: $title - optional title for the head
                   7826:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7827:         $args - optional arguments
1.319     albertel 7828:             force_register - if is true call registerurl so the remote is 
                   7829:                              informed
1.415     albertel 7830:             redirect       -> array ref of
                   7831:                                    1- seconds before redirect occurs
                   7832:                                    2- url to redirect to
                   7833:                                    3- whether the side effect should occur
1.315     albertel 7834:                            (side effect of setting 
                   7835:                                $env{'internal.head.redirect'} to the url 
                   7836:                                redirected too)
1.352     albertel 7837:             domain         -> force to color decorate a page for a specific
                   7838:                                domain
                   7839:             function       -> force usage of a specific rolish color scheme
                   7840:             bgcolor        -> override the default page bgcolor
1.460     albertel 7841:             no_auto_mt_title
                   7842:                            -> prevent &mt()ing the title arg
1.464     albertel 7843: 
1.306     albertel 7844: =cut
                   7845: 
                   7846: sub headtag {
1.313     albertel 7847:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7848:     
1.363     albertel 7849:     my $function = $args->{'function'} || &get_users_function();
                   7850:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7851:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  7852:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7853:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7854: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7855: 		   #time(),
1.418     albertel 7856: 		   $env{'environment.color.timestamp'},
1.363     albertel 7857: 		   $function,$domain,$bgcolor);
                   7858: 
1.369     www      7859:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7860: 
1.308     albertel 7861:     my $result =
                   7862: 	'<head>'.
1.1160    raeburn  7863: 	&font_settings($args);
1.319     albertel 7864: 
1.1188    raeburn  7865:     my $inhibitprint;
                   7866:     if ($args->{'print_suppress'}) {
                   7867:         $inhibitprint = &print_suppression();
                   7868:     }
1.1064    raeburn  7869: 
1.461     albertel 7870:     if (!$args->{'frameset'}) {
                   7871: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7872:     }
1.962     droeschl 7873:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7874:         $result .= Apache::lonxml::display_title();
1.319     albertel 7875:     }
1.436     albertel 7876:     if (!$args->{'no_nav_bar'} 
                   7877: 	&& !$args->{'only_body'}
                   7878: 	&& !$args->{'frameset'}) {
1.1154    raeburn  7879: 	$result .= &help_menu_js($httphost);
1.1032    www      7880:         $result.=&modal_window();
1.1038    www      7881:         $result.=&togglebox_script();
1.1034    www      7882:         $result.=&wishlist_window();
1.1041    www      7883:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7884:     } else {
                   7885:         if ($args->{'add_modal'}) {
                   7886:            $result.=&modal_window();
                   7887:         }
                   7888:         if ($args->{'add_wishlist'}) {
                   7889:            $result.=&wishlist_window();
                   7890:         }
1.1038    www      7891:         if ($args->{'add_togglebox'}) {
                   7892:            $result.=&togglebox_script();
                   7893:         }
1.1041    www      7894:         if ($args->{'add_progressbar'}) {
                   7895:            $result.=&LCprogressbarUpdate_script();
                   7896:         }
1.436     albertel 7897:     }
1.314     albertel 7898:     if (ref($args->{'redirect'})) {
1.414     albertel 7899: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7900: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7901: 	if (!$inhibit_continue) {
                   7902: 	    $env{'internal.head.redirect'} = $url;
                   7903: 	}
1.313     albertel 7904: 	$result.=<<ADDMETA
                   7905: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7906: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7907: ADDMETA
1.1210    raeburn  7908:     } else {
                   7909:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   7910:             my $requrl = $env{'request.uri'};
                   7911:             if ($requrl eq '') {
                   7912:                 $requrl = $ENV{'REQUEST_URI'};
                   7913:                 $requrl =~ s/\?.+$//;
                   7914:             }
                   7915:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   7916:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   7917:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   7918:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   7919:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   7920:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                   7921:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   7922:                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   7923:                         if ($domdefs{'offloadnow'}{$lonhost}) {
                   7924:                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                   7925:                             if (($newserver) && ($newserver ne $lonhost)) {
                   7926:                                 my $numsec = 5;
                   7927:                                 my $timeout = $numsec * 1000;
                   7928:                                 my ($newurl,$locknum,%locks,$msg);
                   7929:                                 if ($env{'request.role.adv'}) {
                   7930:                                     ($locknum,%locks) = &Apache::lonnet::get_locks();
                   7931:                                 }
                   7932:                                 my $disable_submit = 0;
                   7933:                                 if ($requrl =~ /$LONCAPA::assess_re/) {
                   7934:                                     $disable_submit = 1;
                   7935:                                 }
                   7936:                                 if ($locknum) {
                   7937:                                     my @lockinfo = sort(values(%locks));
                   7938:                                     $msg = &mt('Once the following tasks are complete: ')."\\n".
                   7939:                                            join(", ",sort(values(%locks)))."\\n".
                   7940:                                            &mt('your session will be transferred to a different server, after you click "Roles".');
                   7941:                                 } else {
                   7942:                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   7943:                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                   7944:                                     }
                   7945:                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   7946:                                     $newurl = '/adm/switchserver?otherserver='.$newserver;
                   7947:                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   7948:                                         $newurl .= '&role='.$env{'request.role'};
                   7949:                                     }
                   7950:                                     if ($env{'request.symb'}) {
                   7951:                                         $newurl .= '&symb='.$env{'request.symb'};
                   7952:                                     } else {
                   7953:                                         $newurl .= '&origurl='.$requrl;
                   7954:                                     }
                   7955:                                 }
1.1222    damieng  7956:                                 &js_escape(\$msg);
1.1210    raeburn  7957:                                 $result.=<<OFFLOAD
                   7958: <meta http-equiv="pragma" content="no-cache" />
                   7959: <script type="text/javascript">
1.1215    raeburn  7960: // <![CDATA[
1.1210    raeburn  7961: function LC_Offload_Now() {
                   7962:     var dest = "$newurl";
                   7963:     if (dest != '') {
                   7964:         window.location.href="$newurl";
                   7965:     }
                   7966: }
1.1214    raeburn  7967: \$(document).ready(function () {
                   7968:     window.alert('$msg');
                   7969:     if ($disable_submit) {
1.1210    raeburn  7970:         \$(".LC_hwk_submit").prop("disabled", true);
                   7971:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214    raeburn  7972:     }
                   7973:     setTimeout('LC_Offload_Now()', $timeout);
                   7974: });
1.1215    raeburn  7975: // ]]>
1.1210    raeburn  7976: </script>
                   7977: OFFLOAD
                   7978:                             }
                   7979:                         }
                   7980:                     }
                   7981:                 }
                   7982:             }
                   7983:         }
1.313     albertel 7984:     }
1.306     albertel 7985:     if (!defined($title)) {
                   7986: 	$title = 'The LearningOnline Network with CAPA';
                   7987:     }
1.460     albertel 7988:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7989:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  7990: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7991:     if (!$args->{'frameset'}) {
                   7992:         $result .= ' /';
                   7993:     }
                   7994:     $result .= '>' 
1.1064    raeburn  7995:         .$inhibitprint
1.414     albertel 7996: 	.$head_extra;
1.1242    raeburn  7997:     my $clientmobile;
                   7998:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   7999:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   8000:     } else {
                   8001:         $clientmobile = $env{'browser.mobile'};
                   8002:     }
                   8003:     if ($clientmobile) {
1.1137    raeburn  8004:         $result .= '
                   8005: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   8006: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   8007:     }
1.962     droeschl 8008:     return $result.'</head>';
1.306     albertel 8009: }
                   8010: 
                   8011: =pod
                   8012: 
1.340     albertel 8013: =item * &font_settings()
                   8014: 
                   8015: Returns neccessary <meta> to set the proper encoding
                   8016: 
1.1160    raeburn  8017: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 8018: 
                   8019: =cut
                   8020: 
                   8021: sub font_settings {
1.1160    raeburn  8022:     my ($args) = @_;
1.340     albertel 8023:     my $headerstring='';
1.1160    raeburn  8024:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   8025:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  8026:         $headerstring.=
                   8027:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   8028:         if (!$args->{'frameset'}) {
                   8029: 	    $headerstring.= ' /';
                   8030:         }
                   8031: 	$headerstring .= '>'."\n";
1.340     albertel 8032:     }
                   8033:     return $headerstring;
                   8034: }
                   8035: 
1.341     albertel 8036: =pod
                   8037: 
1.1064    raeburn  8038: =item * &print_suppression()
                   8039: 
                   8040: In course context returns css which causes the body to be blank when media="print",
                   8041: if printout generation is unavailable for the current resource.
                   8042: 
                   8043: This could be because:
                   8044: 
                   8045: (a) printstartdate is in the future
                   8046: 
                   8047: (b) printenddate is in the past
                   8048: 
                   8049: (c) there is an active exam block with "printout"
                   8050: functionality blocked
                   8051: 
                   8052: Users with pav, pfo or evb privileges are exempt.
                   8053: 
                   8054: Inputs: none
                   8055: 
                   8056: =cut
                   8057: 
                   8058: 
                   8059: sub print_suppression {
                   8060:     my $noprint;
                   8061:     if ($env{'request.course.id'}) {
                   8062:         my $scope = $env{'request.course.id'};
                   8063:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8064:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   8065:             return;
                   8066:         }
                   8067:         if ($env{'request.course.sec'} ne '') {
                   8068:             $scope .= "/$env{'request.course.sec'}";
                   8069:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8070:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  8071:                 return;
1.1064    raeburn  8072:             }
                   8073:         }
                   8074:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8075:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189    raeburn  8076:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  8077:         if ($blocked) {
                   8078:             my $checkrole = "cm./$cdom/$cnum";
                   8079:             if ($env{'request.course.sec'} ne '') {
                   8080:                 $checkrole .= "/$env{'request.course.sec'}";
                   8081:             }
                   8082:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   8083:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   8084:                 $noprint = 1;
                   8085:             }
                   8086:         }
                   8087:         unless ($noprint) {
                   8088:             my $symb = &Apache::lonnet::symbread();
                   8089:             if ($symb ne '') {
                   8090:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   8091:                 if (ref($navmap)) {
                   8092:                     my $res = $navmap->getBySymb($symb);
                   8093:                     if (ref($res)) {
                   8094:                         if (!$res->resprintable()) {
                   8095:                             $noprint = 1;
                   8096:                         }
                   8097:                     }
                   8098:                 }
                   8099:             }
                   8100:         }
                   8101:         if ($noprint) {
                   8102:             return <<"ENDSTYLE";
                   8103: <style type="text/css" media="print">
                   8104:     body { display:none }
                   8105: </style>
                   8106: ENDSTYLE
                   8107:         }
                   8108:     }
                   8109:     return;
                   8110: }
                   8111: 
                   8112: =pod
                   8113: 
1.341     albertel 8114: =item * &xml_begin()
                   8115: 
                   8116: Returns the needed doctype and <html>
                   8117: 
                   8118: Inputs: none
                   8119: 
                   8120: =cut
                   8121: 
                   8122: sub xml_begin {
1.1168    raeburn  8123:     my ($is_frameset) = @_;
1.341     albertel 8124:     my $output='';
                   8125: 
                   8126:     if ($env{'browser.mathml'}) {
                   8127: 	$output='<?xml version="1.0"?>'
                   8128:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   8129: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   8130:             
                   8131: #	    .'<!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">] >'
                   8132: 	    .'<!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">'
                   8133:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   8134: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  8135:     } elsif ($is_frameset) {
                   8136:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   8137:                 '<html>'."\n";
1.341     albertel 8138:     } else {
1.1168    raeburn  8139: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   8140:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 8141:     }
                   8142:     return $output;
                   8143: }
1.340     albertel 8144: 
                   8145: =pod
                   8146: 
1.306     albertel 8147: =item * &start_page()
                   8148: 
                   8149: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   8150: 
1.648     raeburn  8151: Inputs:
                   8152: 
                   8153: =over 4
                   8154: 
                   8155: $title - optional title for the page
                   8156: 
                   8157: $head_extra - optional extra HTML to incude inside the <head>
                   8158: 
                   8159: $args - additional optional args supported are:
                   8160: 
                   8161: =over 8
                   8162: 
                   8163:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 8164:                                     arg on
1.814     bisitz   8165:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  8166:              add_entries    -> additional attributes to add to the  <body>
                   8167:              domain         -> force to color decorate a page for a 
1.317     albertel 8168:                                     specific domain
1.648     raeburn  8169:              function       -> force usage of a specific rolish color
1.317     albertel 8170:                                     scheme
1.648     raeburn  8171:              redirect       -> see &headtag()
                   8172:              bgcolor        -> override the default page bg color
                   8173:              js_ready       -> return a string ready for being used in 
1.317     albertel 8174:                                     a javascript writeln
1.648     raeburn  8175:              html_encode    -> return a string ready for being used in 
1.320     albertel 8176:                                     a html attribute
1.648     raeburn  8177:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 8178:                                     $forcereg arg
1.648     raeburn  8179:              frameset       -> if true will start with a <frameset>
1.330     albertel 8180:                                     rather than <body>
1.648     raeburn  8181:              skip_phases    -> hash ref of 
1.338     albertel 8182:                                     head -> skip the <html><head> generation
                   8183:                                     body -> skip all <body> generation
1.648     raeburn  8184:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 8185:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  8186:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  8187:              group          -> includes the current group, if page is for a 
                   8188:                                specific group  
1.361     albertel 8189: 
1.648     raeburn  8190: =back
1.460     albertel 8191: 
1.648     raeburn  8192: =back
1.562     albertel 8193: 
1.306     albertel 8194: =cut
                   8195: 
                   8196: sub start_page {
1.309     albertel 8197:     my ($title,$head_extra,$args) = @_;
1.318     albertel 8198:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 8199: 
1.315     albertel 8200:     $env{'internal.start_page'}++;
1.1096    raeburn  8201:     my ($result,@advtools);
1.964     droeschl 8202: 
1.338     albertel 8203:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  8204:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 8205:     }
                   8206:     
                   8207:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   8208: 	if ($args->{'frameset'}) {
                   8209: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   8210: 						$args->{'add_entries'});
                   8211: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   8212:         } else {
                   8213:             $result .=
                   8214:                 &bodytag($title, 
                   8215:                          $args->{'function'},       $args->{'add_entries'},
                   8216:                          $args->{'only_body'},      $args->{'domain'},
                   8217:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  8218:                          $args->{'bgcolor'},        $args,
                   8219:                          \@advtools);
1.831     bisitz   8220:         }
1.330     albertel 8221:     }
1.338     albertel 8222: 
1.315     albertel 8223:     if ($args->{'js_ready'}) {
1.713     kaisler  8224: 		$result = &js_ready($result);
1.315     albertel 8225:     }
1.320     albertel 8226:     if ($args->{'html_encode'}) {
1.713     kaisler  8227: 		$result = &html_encode($result);
                   8228:     }
                   8229: 
1.813     bisitz   8230:     # Preparation for new and consistent functionlist at top of screen
                   8231:     # if ($args->{'functionlist'}) {
                   8232:     #            $result .= &build_functionlist();
                   8233:     #}
                   8234: 
1.964     droeschl 8235:     # Don't add anything more if only_body wanted or in const space
                   8236:     return $result if    $args->{'only_body'} 
                   8237:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   8238: 
                   8239:     #Breadcrumbs
1.758     kaisler  8240:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   8241: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   8242: 		#if any br links exists, add them to the breadcrumbs
                   8243: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   8244: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   8245: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   8246: 			}
                   8247: 		}
1.1096    raeburn  8248:                 # if @advtools array contains items add then to the breadcrumbs
                   8249:                 if (@advtools > 0) {
                   8250:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   8251:                 }
1.758     kaisler  8252: 
                   8253: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   8254: 		if(exists($args->{'bread_crumbs_component'})){
                   8255: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.1237    raeburn  8256: 		} elsif ($args->{'crstype'} eq 'Placement') {
                   8257: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
                   8258:                                                                        $args->{'crstype'});
                   8259:                 } else {
1.758     kaisler  8260: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   8261: 		}
1.320     albertel 8262:     }
1.315     albertel 8263:     return $result;
1.306     albertel 8264: }
                   8265: 
                   8266: sub end_page {
1.315     albertel 8267:     my ($args) = @_;
                   8268:     $env{'internal.end_page'}++;
1.330     albertel 8269:     my $result;
1.335     albertel 8270:     if ($args->{'discussion'}) {
                   8271: 	my ($target,$parser);
                   8272: 	if (ref($args->{'discussion'})) {
                   8273: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   8274: 				$args->{'discussion'}{'parser'});
                   8275: 	}
                   8276: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   8277:     }
1.330     albertel 8278:     if ($args->{'frameset'}) {
                   8279: 	$result .= '</frameset>';
                   8280:     } else {
1.635     raeburn  8281: 	$result .= &endbodytag($args);
1.330     albertel 8282:     }
1.1080    raeburn  8283:     unless ($args->{'notbody'}) {
                   8284:         $result .= "\n</html>";
                   8285:     }
1.330     albertel 8286: 
1.315     albertel 8287:     if ($args->{'js_ready'}) {
1.317     albertel 8288: 	$result = &js_ready($result);
1.315     albertel 8289:     }
1.335     albertel 8290: 
1.320     albertel 8291:     if ($args->{'html_encode'}) {
                   8292: 	$result = &html_encode($result);
                   8293:     }
1.335     albertel 8294: 
1.315     albertel 8295:     return $result;
                   8296: }
                   8297: 
1.1034    www      8298: sub wishlist_window {
                   8299:     return(<<'ENDWISHLIST');
1.1046    raeburn  8300: <script type="text/javascript">
1.1034    www      8301: // <![CDATA[
                   8302: // <!-- BEGIN LON-CAPA Internal
                   8303: function set_wishlistlink(title, path) {
                   8304:     if (!title) {
                   8305:         title = document.title;
                   8306:         title = title.replace(/^LON-CAPA /,'');
                   8307:     }
1.1175    raeburn  8308:     title = encodeURIComponent(title);
1.1203    raeburn  8309:     title = title.replace("'","\\\'");
1.1034    www      8310:     if (!path) {
                   8311:         path = location.pathname;
                   8312:     }
1.1175    raeburn  8313:     path = encodeURIComponent(path);
1.1203    raeburn  8314:     path = path.replace("'","\\\'");
1.1034    www      8315:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   8316:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   8317: }
                   8318: // END LON-CAPA Internal -->
                   8319: // ]]>
                   8320: </script>
                   8321: ENDWISHLIST
                   8322: }
                   8323: 
1.1030    www      8324: sub modal_window {
                   8325:     return(<<'ENDMODAL');
1.1046    raeburn  8326: <script type="text/javascript">
1.1030    www      8327: // <![CDATA[
                   8328: // <!-- BEGIN LON-CAPA Internal
                   8329: var modalWindow = {
                   8330: 	parent:"body",
                   8331: 	windowId:null,
                   8332: 	content:null,
                   8333: 	width:null,
                   8334: 	height:null,
                   8335: 	close:function()
                   8336: 	{
                   8337: 	        $(".LCmodal-window").remove();
                   8338: 	        $(".LCmodal-overlay").remove();
                   8339: 	},
                   8340: 	open:function()
                   8341: 	{
                   8342: 		var modal = "";
                   8343: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   8344: 		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;\">";
                   8345: 		modal += this.content;
                   8346: 		modal += "</div>";	
                   8347: 
                   8348: 		$(this.parent).append(modal);
                   8349: 
                   8350: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   8351: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   8352: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   8353: 	}
                   8354: };
1.1140    raeburn  8355: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      8356: 	{
1.1203    raeburn  8357:                 source = source.replace("'","&#39;");
1.1030    www      8358: 		modalWindow.windowId = "myModal";
                   8359: 		modalWindow.width = width;
                   8360: 		modalWindow.height = height;
1.1196    raeburn  8361: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      8362: 		modalWindow.open();
1.1208    raeburn  8363: 	};
1.1030    www      8364: // END LON-CAPA Internal -->
                   8365: // ]]>
                   8366: </script>
                   8367: ENDMODAL
                   8368: }
                   8369: 
                   8370: sub modal_link {
1.1140    raeburn  8371:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      8372:     unless ($width) { $width=480; }
                   8373:     unless ($height) { $height=400; }
1.1031    www      8374:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  8375:     unless ($transparency) { $transparency='true'; }
                   8376: 
1.1074    raeburn  8377:     my $target_attr;
                   8378:     if (defined($target)) {
                   8379:         $target_attr = 'target="'.$target.'"';
                   8380:     }
                   8381:     return <<"ENDLINK";
1.1140    raeburn  8382: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  8383:            $linktext</a>
                   8384: ENDLINK
1.1030    www      8385: }
                   8386: 
1.1032    www      8387: sub modal_adhoc_script {
                   8388:     my ($funcname,$width,$height,$content)=@_;
                   8389:     return (<<ENDADHOC);
1.1046    raeburn  8390: <script type="text/javascript">
1.1032    www      8391: // <![CDATA[
                   8392:         var $funcname = function()
                   8393:         {
                   8394:                 modalWindow.windowId = "myModal";
                   8395:                 modalWindow.width = $width;
                   8396:                 modalWindow.height = $height;
                   8397:                 modalWindow.content = '$content';
                   8398:                 modalWindow.open();
                   8399:         };  
                   8400: // ]]>
                   8401: </script>
                   8402: ENDADHOC
                   8403: }
                   8404: 
1.1041    www      8405: sub modal_adhoc_inner {
                   8406:     my ($funcname,$width,$height,$content)=@_;
                   8407:     my $innerwidth=$width-20;
                   8408:     $content=&js_ready(
1.1140    raeburn  8409:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   8410:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   8411:                  $content.
1.1041    www      8412:                  &end_scrollbox().
1.1140    raeburn  8413:                  &end_page()
1.1041    www      8414:              );
                   8415:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   8416: }
                   8417: 
                   8418: sub modal_adhoc_window {
                   8419:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   8420:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   8421:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   8422: }
                   8423: 
                   8424: sub modal_adhoc_launch {
                   8425:     my ($funcname,$width,$height,$content)=@_;
                   8426:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   8427: <script type="text/javascript">
                   8428: // <![CDATA[
                   8429: $funcname();
                   8430: // ]]>
                   8431: </script>
                   8432: ENDLAUNCH
                   8433: }
                   8434: 
                   8435: sub modal_adhoc_close {
                   8436:     return (<<ENDCLOSE);
                   8437: <script type="text/javascript">
                   8438: // <![CDATA[
                   8439: modalWindow.close();
                   8440: // ]]>
                   8441: </script>
                   8442: ENDCLOSE
                   8443: }
                   8444: 
1.1038    www      8445: sub togglebox_script {
                   8446:    return(<<ENDTOGGLE);
                   8447: <script type="text/javascript"> 
                   8448: // <![CDATA[
                   8449: function LCtoggleDisplay(id,hidetext,showtext) {
                   8450:    link = document.getElementById(id + "link").childNodes[0];
                   8451:    with (document.getElementById(id).style) {
                   8452:       if (display == "none" ) {
                   8453:           display = "inline";
                   8454:           link.nodeValue = hidetext;
                   8455:         } else {
                   8456:           display = "none";
                   8457:           link.nodeValue = showtext;
                   8458:        }
                   8459:    }
                   8460: }
                   8461: // ]]>
                   8462: </script>
                   8463: ENDTOGGLE
                   8464: }
                   8465: 
1.1039    www      8466: sub start_togglebox {
                   8467:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8468:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8469:     unless ($showtext) { $showtext=&mt('show'); }
                   8470:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8471:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8472:     return &start_data_table().
                   8473:            &start_data_table_header_row().
                   8474:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8475:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8476:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8477:            &end_data_table_header_row().
                   8478:            '<tr id="'.$id.'" style="display:none""><td>';
                   8479: }
                   8480: 
                   8481: sub end_togglebox {
                   8482:     return '</td></tr>'.&end_data_table();
                   8483: }
                   8484: 
1.1041    www      8485: sub LCprogressbar_script {
1.1045    www      8486:    my ($id)=@_;
1.1041    www      8487:    return(<<ENDPROGRESS);
                   8488: <script type="text/javascript">
                   8489: // <![CDATA[
1.1045    www      8490: \$('#progressbar$id').progressbar({
1.1041    www      8491:   value: 0,
                   8492:   change: function(event, ui) {
                   8493:     var newVal = \$(this).progressbar('option', 'value');
                   8494:     \$('.pblabel', this).text(LCprogressTxt);
                   8495:   }
                   8496: });
                   8497: // ]]>
                   8498: </script>
                   8499: ENDPROGRESS
                   8500: }
                   8501: 
                   8502: sub LCprogressbarUpdate_script {
                   8503:    return(<<ENDPROGRESSUPDATE);
                   8504: <style type="text/css">
                   8505: .ui-progressbar { position:relative; }
                   8506: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8507: </style>
                   8508: <script type="text/javascript">
                   8509: // <![CDATA[
1.1045    www      8510: var LCprogressTxt='---';
                   8511: 
                   8512: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      8513:    LCprogressTxt=progresstext;
1.1045    www      8514:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      8515: }
                   8516: // ]]>
                   8517: </script>
                   8518: ENDPROGRESSUPDATE
                   8519: }
                   8520: 
1.1042    www      8521: my $LClastpercent;
1.1045    www      8522: my $LCidcnt;
                   8523: my $LCcurrentid;
1.1042    www      8524: 
1.1041    www      8525: sub LCprogressbar {
1.1042    www      8526:     my ($r)=(@_);
                   8527:     $LClastpercent=0;
1.1045    www      8528:     $LCidcnt++;
                   8529:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      8530:     my $starting=&mt('Starting');
                   8531:     my $content=(<<ENDPROGBAR);
1.1045    www      8532:   <div id="progressbar$LCcurrentid">
1.1041    www      8533:     <span class="pblabel">$starting</span>
                   8534:   </div>
                   8535: ENDPROGBAR
1.1045    www      8536:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      8537: }
                   8538: 
                   8539: sub LCprogressbarUpdate {
1.1042    www      8540:     my ($r,$val,$text)=@_;
                   8541:     unless ($val) { 
                   8542:        if ($LClastpercent) {
                   8543:            $val=$LClastpercent;
                   8544:        } else {
                   8545:            $val=0;
                   8546:        }
                   8547:     }
1.1041    www      8548:     if ($val<0) { $val=0; }
                   8549:     if ($val>100) { $val=0; }
1.1042    www      8550:     $LClastpercent=$val;
1.1041    www      8551:     unless ($text) { $text=$val.'%'; }
                   8552:     $text=&js_ready($text);
1.1044    www      8553:     &r_print($r,<<ENDUPDATE);
1.1041    www      8554: <script type="text/javascript">
                   8555: // <![CDATA[
1.1045    www      8556: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      8557: // ]]>
                   8558: </script>
                   8559: ENDUPDATE
1.1035    www      8560: }
                   8561: 
1.1042    www      8562: sub LCprogressbarClose {
                   8563:     my ($r)=@_;
                   8564:     $LClastpercent=0;
1.1044    www      8565:     &r_print($r,<<ENDCLOSE);
1.1042    www      8566: <script type="text/javascript">
                   8567: // <![CDATA[
1.1045    www      8568: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8569: // ]]>
                   8570: </script>
                   8571: ENDCLOSE
1.1044    www      8572: }
                   8573: 
                   8574: sub r_print {
                   8575:     my ($r,$to_print)=@_;
                   8576:     if ($r) {
                   8577:       $r->print($to_print);
                   8578:       $r->rflush();
                   8579:     } else {
                   8580:       print($to_print);
                   8581:     }
1.1042    www      8582: }
                   8583: 
1.320     albertel 8584: sub html_encode {
                   8585:     my ($result) = @_;
                   8586: 
1.322     albertel 8587:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8588:     
                   8589:     return $result;
                   8590: }
1.1044    www      8591: 
1.317     albertel 8592: sub js_ready {
                   8593:     my ($result) = @_;
                   8594: 
1.323     albertel 8595:     $result =~ s/[\n\r]/ /xmsg;
                   8596:     $result =~ s/\\/\\\\/xmsg;
                   8597:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8598:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8599:     
                   8600:     return $result;
                   8601: }
                   8602: 
1.315     albertel 8603: sub validate_page {
                   8604:     if (  exists($env{'internal.start_page'})
1.316     albertel 8605: 	  &&     $env{'internal.start_page'} > 1) {
                   8606: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8607: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8608: 				 $ENV{'request.filename'});
1.315     albertel 8609:     }
                   8610:     if (  exists($env{'internal.end_page'})
1.316     albertel 8611: 	  &&     $env{'internal.end_page'} > 1) {
                   8612: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8613: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8614: 				 $env{'request.filename'});
1.315     albertel 8615:     }
                   8616:     if (     exists($env{'internal.start_page'})
                   8617: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8618: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8619: 				 $env{'request.filename'});
1.315     albertel 8620:     }
                   8621:     if (   ! exists($env{'internal.start_page'})
                   8622: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8623: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8624: 				 $env{'request.filename'});
1.315     albertel 8625:     }
1.306     albertel 8626: }
1.315     albertel 8627: 
1.996     www      8628: 
                   8629: sub start_scrollbox {
1.1140    raeburn  8630:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8631:     unless ($outerwidth) { $outerwidth='520px'; }
                   8632:     unless ($width) { $width='500px'; }
                   8633:     unless ($height) { $height='200px'; }
1.1075    raeburn  8634:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8635:     if ($id ne '') {
1.1140    raeburn  8636:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  8637:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8638:     }
1.1075    raeburn  8639:     if ($bgcolor ne '') {
                   8640:         $tdcol = "background-color: $bgcolor;";
                   8641:     }
1.1137    raeburn  8642:     my $nicescroll_js;
                   8643:     if ($env{'browser.mobile'}) {
1.1140    raeburn  8644:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8645:     }
                   8646:     return <<"END";
                   8647: $nicescroll_js
                   8648: 
                   8649: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   8650: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   8651: END
                   8652: }
                   8653: 
                   8654: sub end_scrollbox {
                   8655:     return '</div></td></tr></table>';
                   8656: }
                   8657: 
                   8658: sub nicescroll_javascript {
                   8659:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8660:     my %options;
                   8661:     if (ref($cursor) eq 'HASH') {
                   8662:         %options = %{$cursor};
                   8663:     }
                   8664:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8665:         $options{'railalign'} = 'left';
                   8666:     }
                   8667:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8668:         my $function  = &get_users_function();
                   8669:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  8670:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  8671:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  8672:         }
1.1140    raeburn  8673:     }
                   8674:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8675:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  8676:             $options{'cursoropacity'}='1.0';
                   8677:         }
1.1140    raeburn  8678:     } else {
                   8679:         $options{'cursoropacity'}='1.0';
                   8680:     }
                   8681:     if ($options{'cursorfixedheight'} eq 'none') {
                   8682:         delete($options{'cursorfixedheight'});
                   8683:     } else {
                   8684:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8685:     }
                   8686:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8687:         delete($options{'railoffset'});
                   8688:     }
                   8689:     my @niceoptions;
                   8690:     while (my($key,$value) = each(%options)) {
                   8691:         if ($value =~ /^\{.+\}$/) {
                   8692:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8693:         } else {
1.1140    raeburn  8694:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8695:         }
1.1140    raeburn  8696:     }
                   8697:     my $nicescroll_js = '
1.1137    raeburn  8698: $(document).ready(
1.1140    raeburn  8699:       function() {
                   8700:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8701:       }
1.1137    raeburn  8702: );
                   8703: ';
1.1140    raeburn  8704:     if ($framecheck) {
                   8705:         $nicescroll_js .= '
                   8706: function expand_div(caller) {
                   8707:     if (top === self) {
                   8708:         document.getElementById("'.$id.'").style.width = "auto";
                   8709:         document.getElementById("'.$id.'").style.height = "auto";
                   8710:     } else {
                   8711:         try {
                   8712:             if (parent.frames) {
                   8713:                 if (parent.frames.length > 1) {
                   8714:                     var framesrc = parent.frames[1].location.href;
                   8715:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8716:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8717:                         document.getElementById("'.$id.'").style.width = "auto";
                   8718:                         document.getElementById("'.$id.'").style.height = "auto";
                   8719:                     }
                   8720:                 }
                   8721:             }
                   8722:         } catch (e) {
                   8723:             return;
                   8724:         }
1.1137    raeburn  8725:     }
1.1140    raeburn  8726:     return;
1.996     www      8727: }
1.1140    raeburn  8728: ';
                   8729:     }
                   8730:     if ($needjsready) {
                   8731:         $nicescroll_js = '
                   8732: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8733:     } else {
                   8734:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8735:     }
                   8736:     return $nicescroll_js;
1.996     www      8737: }
                   8738: 
1.318     albertel 8739: sub simple_error_page {
1.1150    bisitz   8740:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  8741:     if (ref($args) eq 'HASH') {
                   8742:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8743:     } else {
                   8744:         $msg = &mt($msg);
                   8745:     }
1.1150    bisitz   8746: 
1.318     albertel 8747:     my $page =
                   8748: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   8749: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8750: 	&Apache::loncommon::end_page();
                   8751:     if (ref($r)) {
                   8752: 	$r->print($page);
1.327     albertel 8753: 	return;
1.318     albertel 8754:     }
                   8755:     return $page;
                   8756: }
1.347     albertel 8757: 
                   8758: {
1.610     albertel 8759:     my @row_count;
1.961     onken    8760: 
                   8761:     sub start_data_table_count {
                   8762:         unshift(@row_count, 0);
                   8763:         return;
                   8764:     }
                   8765: 
                   8766:     sub end_data_table_count {
                   8767:         shift(@row_count);
                   8768:         return;
                   8769:     }
                   8770: 
1.347     albertel 8771:     sub start_data_table {
1.1018    raeburn  8772: 	my ($add_class,$id) = @_;
1.422     albertel 8773: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8774:         my $table_id;
                   8775:         if (defined($id)) {
                   8776:             $table_id = ' id="'.$id.'"';
                   8777:         }
1.961     onken    8778: 	&start_data_table_count();
1.1018    raeburn  8779: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8780:     }
                   8781: 
                   8782:     sub end_data_table {
1.961     onken    8783: 	&end_data_table_count();
1.389     albertel 8784: 	return '</table>'."\n";;
1.347     albertel 8785:     }
                   8786: 
                   8787:     sub start_data_table_row {
1.974     wenzelju 8788: 	my ($add_class, $id) = @_;
1.610     albertel 8789: 	$row_count[0]++;
                   8790: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8791: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8792:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8793:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8794:     }
1.471     banghart 8795:     
                   8796:     sub continue_data_table_row {
1.974     wenzelju 8797: 	my ($add_class, $id) = @_;
1.610     albertel 8798: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8799: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8800:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8801:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8802:     }
1.347     albertel 8803: 
                   8804:     sub end_data_table_row {
1.389     albertel 8805: 	return '</tr>'."\n";;
1.347     albertel 8806:     }
1.367     www      8807: 
1.421     albertel 8808:     sub start_data_table_empty_row {
1.707     bisitz   8809: #	$row_count[0]++;
1.421     albertel 8810: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8811:     }
                   8812: 
                   8813:     sub end_data_table_empty_row {
                   8814: 	return '</tr>'."\n";;
                   8815:     }
                   8816: 
1.367     www      8817:     sub start_data_table_header_row {
1.389     albertel 8818: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8819:     }
                   8820: 
                   8821:     sub end_data_table_header_row {
1.389     albertel 8822: 	return '</tr>'."\n";;
1.367     www      8823:     }
1.890     droeschl 8824: 
                   8825:     sub data_table_caption {
                   8826:         my $caption = shift;
                   8827:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8828:     }
1.347     albertel 8829: }
                   8830: 
1.548     albertel 8831: =pod
                   8832: 
                   8833: =item * &inhibit_menu_check($arg)
                   8834: 
                   8835: Checks for a inhibitmenu state and generates output to preserve it
                   8836: 
                   8837: Inputs:         $arg - can be any of
                   8838:                      - undef - in which case the return value is a string 
                   8839:                                to add  into arguments list of a uri
                   8840:                      - 'input' - in which case the return value is a HTML
                   8841:                                  <form> <input> field of type hidden to
                   8842:                                  preserve the value
                   8843:                      - a url - in which case the return value is the url with
                   8844:                                the neccesary cgi args added to preserve the
                   8845:                                inhibitmenu state
                   8846:                      - a ref to a url - no return value, but the string is
                   8847:                                         updated to include the neccessary cgi
                   8848:                                         args to preserve the inhibitmenu state
                   8849: 
                   8850: =cut
                   8851: 
                   8852: sub inhibit_menu_check {
                   8853:     my ($arg) = @_;
                   8854:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8855:     if ($arg eq 'input') {
                   8856: 	if ($env{'form.inhibitmenu'}) {
                   8857: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8858: 	} else {
                   8859: 	    return
                   8860: 	}
                   8861:     }
                   8862:     if ($env{'form.inhibitmenu'}) {
                   8863: 	if (ref($arg)) {
                   8864: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8865: 	} elsif ($arg eq '') {
                   8866: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8867: 	} else {
                   8868: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8869: 	}
                   8870:     }
                   8871:     if (!ref($arg)) {
                   8872: 	return $arg;
                   8873:     }
                   8874: }
                   8875: 
1.251     albertel 8876: ###############################################
1.182     matthew  8877: 
                   8878: =pod
                   8879: 
1.549     albertel 8880: =back
                   8881: 
                   8882: =head1 User Information Routines
                   8883: 
                   8884: =over 4
                   8885: 
1.405     albertel 8886: =item * &get_users_function()
1.182     matthew  8887: 
                   8888: Used by &bodytag to determine the current users primary role.
                   8889: Returns either 'student','coordinator','admin', or 'author'.
                   8890: 
                   8891: =cut
                   8892: 
                   8893: ###############################################
                   8894: sub get_users_function {
1.815     tempelho 8895:     my $function = 'norole';
1.818     tempelho 8896:     if ($env{'request.role'}=~/^(st)/) {
                   8897:         $function='student';
                   8898:     }
1.907     raeburn  8899:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8900:         $function='coordinator';
                   8901:     }
1.258     albertel 8902:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8903:         $function='admin';
                   8904:     }
1.826     bisitz   8905:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8906:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8907:         $function='author';
                   8908:     }
                   8909:     return $function;
1.54      www      8910: }
1.99      www      8911: 
                   8912: ###############################################
                   8913: 
1.233     raeburn  8914: =pod
                   8915: 
1.821     raeburn  8916: =item * &show_course()
                   8917: 
                   8918: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8919: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8920: 
                   8921: Inputs:
                   8922: None
                   8923: 
                   8924: Outputs:
                   8925: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8926: 
                   8927: =cut
                   8928: 
                   8929: ###############################################
                   8930: sub show_course {
                   8931:     my $course = !$env{'user.adv'};
                   8932:     if (!$env{'user.adv'}) {
                   8933:         foreach my $env (keys(%env)) {
                   8934:             next if ($env !~ m/^user\.priv\./);
                   8935:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8936:                 $course = 0;
                   8937:                 last;
                   8938:             }
                   8939:         }
                   8940:     }
                   8941:     return $course;
                   8942: }
                   8943: 
                   8944: ###############################################
                   8945: 
                   8946: =pod
                   8947: 
1.542     raeburn  8948: =item * &check_user_status()
1.274     raeburn  8949: 
                   8950: Determines current status of supplied role for a
                   8951: specific user. Roles can be active, previous or future.
                   8952: 
                   8953: Inputs: 
                   8954: user's domain, user's username, course's domain,
1.375     raeburn  8955: course's number, optional section ID.
1.274     raeburn  8956: 
                   8957: Outputs:
                   8958: role status: active, previous or future. 
                   8959: 
                   8960: =cut
                   8961: 
                   8962: sub check_user_status {
1.412     raeburn  8963:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8964:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202    raeburn  8965:     my @uroles = keys(%userinfo);
1.274     raeburn  8966:     my $srchstr;
                   8967:     my $active_chk = 'none';
1.412     raeburn  8968:     my $now = time;
1.274     raeburn  8969:     if (@uroles > 0) {
1.908     raeburn  8970:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8971:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8972:         } else {
1.412     raeburn  8973:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8974:         }
                   8975:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8976:             my $role_end = 0;
                   8977:             my $role_start = 0;
                   8978:             $active_chk = 'active';
1.412     raeburn  8979:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8980:                 $role_end = $1;
                   8981:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8982:                     $role_start = $1;
1.274     raeburn  8983:                 }
                   8984:             }
                   8985:             if ($role_start > 0) {
1.412     raeburn  8986:                 if ($now < $role_start) {
1.274     raeburn  8987:                     $active_chk = 'future';
                   8988:                 }
                   8989:             }
                   8990:             if ($role_end > 0) {
1.412     raeburn  8991:                 if ($now > $role_end) {
1.274     raeburn  8992:                     $active_chk = 'previous';
                   8993:                 }
                   8994:             }
                   8995:         }
                   8996:     }
                   8997:     return $active_chk;
                   8998: }
                   8999: 
                   9000: ###############################################
                   9001: 
                   9002: =pod
                   9003: 
1.405     albertel 9004: =item * &get_sections()
1.233     raeburn  9005: 
                   9006: Determines all the sections for a course including
                   9007: sections with students and sections containing other roles.
1.419     raeburn  9008: Incoming parameters: 
                   9009: 
                   9010: 1. domain
                   9011: 2. course number 
                   9012: 3. reference to array containing roles for which sections should 
                   9013: be gathered (optional).
                   9014: 4. reference to array containing status types for which sections 
                   9015: should be gathered (optional).
                   9016: 
                   9017: If the third argument is undefined, sections are gathered for any role. 
                   9018: If the fourth argument is undefined, sections are gathered for any status.
                   9019: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  9020:  
1.374     raeburn  9021: Returns section hash (keys are section IDs, values are
                   9022: number of users in each section), subject to the
1.419     raeburn  9023: optional roles filter, optional status filter 
1.233     raeburn  9024: 
                   9025: =cut
                   9026: 
                   9027: ###############################################
                   9028: sub get_sections {
1.419     raeburn  9029:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 9030:     if (!defined($cdom) || !defined($cnum)) {
                   9031:         my $cid =  $env{'request.course.id'};
                   9032: 
                   9033: 	return if (!defined($cid));
                   9034: 
                   9035:         $cdom = $env{'course.'.$cid.'.domain'};
                   9036:         $cnum = $env{'course.'.$cid.'.num'};
                   9037:     }
                   9038: 
                   9039:     my %sectioncount;
1.419     raeburn  9040:     my $now = time;
1.240     albertel 9041: 
1.1118    raeburn  9042:     my $check_students = 1;
                   9043:     my $only_students = 0;
                   9044:     if (ref($possible_roles) eq 'ARRAY') {
                   9045:         if (grep(/^st$/,@{$possible_roles})) {
                   9046:             if (@{$possible_roles} == 1) {
                   9047:                 $only_students = 1;
                   9048:             }
                   9049:         } else {
                   9050:             $check_students = 0;
                   9051:         }
                   9052:     }
                   9053: 
                   9054:     if ($check_students) { 
1.276     albertel 9055: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 9056: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   9057: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  9058:         my $start_index = &Apache::loncoursedata::CL_START();
                   9059:         my $end_index = &Apache::loncoursedata::CL_END();
                   9060:         my $status;
1.366     albertel 9061: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  9062: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   9063: 				                     $data->[$status_index],
                   9064:                                                      $data->[$start_index],
                   9065:                                                      $data->[$end_index]);
                   9066:             if ($stu_status eq 'Active') {
                   9067:                 $status = 'active';
                   9068:             } elsif ($end < $now) {
                   9069:                 $status = 'previous';
                   9070:             } elsif ($start > $now) {
                   9071:                 $status = 'future';
                   9072:             } 
                   9073: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   9074:                 if ((!defined($possible_status)) || (($status ne '') && 
                   9075:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   9076: 		    $sectioncount{$section}++;
                   9077:                 }
1.240     albertel 9078: 	    }
                   9079: 	}
                   9080:     }
1.1118    raeburn  9081:     if ($only_students) {
                   9082:         return %sectioncount;
                   9083:     }
1.240     albertel 9084:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9085:     foreach my $user (sort(keys(%courseroles))) {
                   9086: 	if ($user !~ /^(\w{2})/) { next; }
                   9087: 	my ($role) = ($user =~ /^(\w{2})/);
                   9088: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  9089: 	my ($section,$status);
1.240     albertel 9090: 	if ($role eq 'cr' &&
                   9091: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   9092: 	    $section=$1;
                   9093: 	}
                   9094: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   9095: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  9096:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   9097:         if ($end == -1 && $start == -1) {
                   9098:             next; #deleted role
                   9099:         }
                   9100:         if (!defined($possible_status)) { 
                   9101:             $sectioncount{$section}++;
                   9102:         } else {
                   9103:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   9104:                 $status = 'active';
                   9105:             } elsif ($end < $now) {
                   9106:                 $status = 'future';
                   9107:             } elsif ($start > $now) {
                   9108:                 $status = 'previous';
                   9109:             }
                   9110:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   9111:                 $sectioncount{$section}++;
                   9112:             }
                   9113:         }
1.233     raeburn  9114:     }
1.366     albertel 9115:     return %sectioncount;
1.233     raeburn  9116: }
                   9117: 
1.274     raeburn  9118: ###############################################
1.294     raeburn  9119: 
                   9120: =pod
1.405     albertel 9121: 
                   9122: =item * &get_course_users()
                   9123: 
1.275     raeburn  9124: Retrieves usernames:domains for users in the specified course
                   9125: with specific role(s), and access status. 
                   9126: 
                   9127: Incoming parameters:
1.277     albertel 9128: 1. course domain
                   9129: 2. course number
                   9130: 3. access status: users must have - either active, 
1.275     raeburn  9131: previous, future, or all.
1.277     albertel 9132: 4. reference to array of permissible roles
1.288     raeburn  9133: 5. reference to array of section restrictions (optional)
                   9134: 6. reference to results object (hash of hashes).
                   9135: 7. reference to optional userdata hash
1.609     raeburn  9136: 8. reference to optional statushash
1.630     raeburn  9137: 9. flag if privileged users (except those set to unhide in
                   9138:    course settings) should be excluded    
1.609     raeburn  9139: Keys of top level results hash are roles.
1.275     raeburn  9140: Keys of inner hashes are username:domain, with 
                   9141: values set to access type.
1.288     raeburn  9142: Optional userdata hash returns an array with arguments in the 
                   9143: same order as loncoursedata::get_classlist() for student data.
                   9144: 
1.609     raeburn  9145: Optional statushash returns
                   9146: 
1.288     raeburn  9147: Entries for end, start, section and status are blank because
                   9148: of the possibility of multiple values for non-student roles.
                   9149: 
1.275     raeburn  9150: =cut
1.405     albertel 9151: 
1.275     raeburn  9152: ###############################################
1.405     albertel 9153: 
1.275     raeburn  9154: sub get_course_users {
1.630     raeburn  9155:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  9156:     my %idx = ();
1.419     raeburn  9157:     my %seclists;
1.288     raeburn  9158: 
                   9159:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   9160:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   9161:     $idx{end} = &Apache::loncoursedata::CL_END();
                   9162:     $idx{start} = &Apache::loncoursedata::CL_START();
                   9163:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   9164:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   9165:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   9166:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   9167: 
1.290     albertel 9168:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 9169:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  9170:         my $now = time;
1.277     albertel 9171:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  9172:             my $match = 0;
1.412     raeburn  9173:             my $secmatch = 0;
1.419     raeburn  9174:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  9175:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  9176:             if ($section eq '') {
                   9177:                 $section = 'none';
                   9178:             }
1.291     albertel 9179:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9180:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9181:                     $secmatch = 1;
                   9182:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 9183:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9184:                         $secmatch = 1;
                   9185:                     }
                   9186:                 } else {  
1.419     raeburn  9187: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  9188: 		        $secmatch = 1;
                   9189:                     }
1.290     albertel 9190: 		}
1.412     raeburn  9191:                 if (!$secmatch) {
                   9192:                     next;
                   9193:                 }
1.419     raeburn  9194:             }
1.275     raeburn  9195:             if (defined($$types{'active'})) {
1.288     raeburn  9196:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  9197:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  9198:                     $match = 1;
1.275     raeburn  9199:                 }
                   9200:             }
                   9201:             if (defined($$types{'previous'})) {
1.609     raeburn  9202:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  9203:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  9204:                     $match = 1;
1.275     raeburn  9205:                 }
                   9206:             }
                   9207:             if (defined($$types{'future'})) {
1.609     raeburn  9208:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  9209:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  9210:                     $match = 1;
1.275     raeburn  9211:                 }
                   9212:             }
1.609     raeburn  9213:             if ($match) {
                   9214:                 push(@{$seclists{$student}},$section);
                   9215:                 if (ref($userdata) eq 'HASH') {
                   9216:                     $$userdata{$student} = $$classlist{$student};
                   9217:                 }
                   9218:                 if (ref($statushash) eq 'HASH') {
                   9219:                     $statushash->{$student}{'st'}{$section} = $status;
                   9220:                 }
1.288     raeburn  9221:             }
1.275     raeburn  9222:         }
                   9223:     }
1.412     raeburn  9224:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  9225:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9226:         my $now = time;
1.609     raeburn  9227:         my %displaystatus = ( previous => 'Expired',
                   9228:                               active   => 'Active',
                   9229:                               future   => 'Future',
                   9230:                             );
1.1121    raeburn  9231:         my (%nothide,@possdoms);
1.630     raeburn  9232:         if ($hidepriv) {
                   9233:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   9234:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   9235:                 if ($user !~ /:/) {
                   9236:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   9237:                 } else {
                   9238:                     $nothide{$user} = 1;
                   9239:                 }
                   9240:             }
1.1121    raeburn  9241:             my @possdoms = ($cdom);
                   9242:             if ($coursehash{'checkforpriv'}) {
                   9243:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   9244:             }
1.630     raeburn  9245:         }
1.439     raeburn  9246:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  9247:             my $match = 0;
1.412     raeburn  9248:             my $secmatch = 0;
1.439     raeburn  9249:             my $status;
1.412     raeburn  9250:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  9251:             $user =~ s/:$//;
1.439     raeburn  9252:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   9253:             if ($end == -1 || $start == -1) {
                   9254:                 next;
                   9255:             }
                   9256:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   9257:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  9258:                 my ($uname,$udom) = split(/:/,$user);
                   9259:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9260:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9261:                         $secmatch = 1;
                   9262:                     } elsif ($usec eq '') {
1.420     albertel 9263:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9264:                             $secmatch = 1;
                   9265:                         }
                   9266:                     } else {
                   9267:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   9268:                             $secmatch = 1;
                   9269:                         }
                   9270:                     }
                   9271:                     if (!$secmatch) {
                   9272:                         next;
                   9273:                     }
1.288     raeburn  9274:                 }
1.419     raeburn  9275:                 if ($usec eq '') {
                   9276:                     $usec = 'none';
                   9277:                 }
1.275     raeburn  9278:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  9279:                     if ($hidepriv) {
1.1121    raeburn  9280:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  9281:                             (!$nothide{$uname.':'.$udom})) {
                   9282:                             next;
                   9283:                         }
                   9284:                     }
1.503     raeburn  9285:                     if ($end > 0 && $end < $now) {
1.439     raeburn  9286:                         $status = 'previous';
                   9287:                     } elsif ($start > $now) {
                   9288:                         $status = 'future';
                   9289:                     } else {
                   9290:                         $status = 'active';
                   9291:                     }
1.277     albertel 9292:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  9293:                         if ($status eq $type) {
1.420     albertel 9294:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  9295:                                 push(@{$$users{$role}{$user}},$type);
                   9296:                             }
1.288     raeburn  9297:                             $match = 1;
                   9298:                         }
                   9299:                     }
1.419     raeburn  9300:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   9301:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   9302: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   9303:                         }
1.420     albertel 9304:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  9305:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   9306:                         }
1.609     raeburn  9307:                         if (ref($statushash) eq 'HASH') {
                   9308:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   9309:                         }
1.275     raeburn  9310:                     }
                   9311:                 }
                   9312:             }
                   9313:         }
1.290     albertel 9314:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  9315:             if ((defined($cdom)) && (defined($cnum))) {
                   9316:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   9317:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   9318:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  9319:                     next if ($owner eq '');
                   9320:                     my ($ownername,$ownerdom);
                   9321:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   9322:                         $ownername = $1;
                   9323:                         $ownerdom = $2;
                   9324:                     } else {
                   9325:                         $ownername = $owner;
                   9326:                         $ownerdom = $cdom;
                   9327:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  9328:                     }
                   9329:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 9330:                     if (defined($userdata) && 
1.609     raeburn  9331: 			!exists($$userdata{$owner})) {
                   9332: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   9333:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   9334:                             push(@{$seclists{$owner}},'none');
                   9335:                         }
                   9336:                         if (ref($statushash) eq 'HASH') {
                   9337:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  9338:                         }
1.290     albertel 9339: 		    }
1.279     raeburn  9340:                 }
                   9341:             }
                   9342:         }
1.419     raeburn  9343:         foreach my $user (keys(%seclists)) {
                   9344:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   9345:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   9346:         }
1.275     raeburn  9347:     }
                   9348:     return;
                   9349: }
                   9350: 
1.288     raeburn  9351: sub get_user_info {
                   9352:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 9353:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   9354: 	&plainname($uname,$udom,'lastname');
1.291     albertel 9355:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  9356:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  9357:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   9358:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  9359:     return;
                   9360: }
1.275     raeburn  9361: 
1.472     raeburn  9362: ###############################################
                   9363: 
                   9364: =pod
                   9365: 
                   9366: =item * &get_user_quota()
                   9367: 
1.1134    raeburn  9368: Retrieves quota assigned for storage of user files.
                   9369: Default is to report quota for portfolio files.
1.472     raeburn  9370: 
                   9371: Incoming parameters:
                   9372: 1. user's username
                   9373: 2. user's domain
1.1134    raeburn  9374: 3. quota name - portfolio, author, or course
1.1136    raeburn  9375:    (if no quota name provided, defaults to portfolio).
1.1237    raeburn  9376: 4. crstype - official, unofficial, textbook, placement or community, 
                   9377:    if quota name is course
1.472     raeburn  9378: 
                   9379: Returns:
1.1163    raeburn  9380: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  9381: 2. (Optional) Type of setting: custom or default
                   9382:    (individually assigned or default for user's 
                   9383:    institutional status).
                   9384: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   9385:    or student - types as defined in localenroll::inst_usertypes 
                   9386:    for user's domain, which determines default quota for user.
                   9387: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  9388: 
                   9389: If a value has been stored in the user's environment, 
1.536     raeburn  9390: it will return that, otherwise it returns the maximal default
1.1134    raeburn  9391: defined for the user's institutional status(es) in the domain.
1.472     raeburn  9392: 
                   9393: =cut
                   9394: 
                   9395: ###############################################
                   9396: 
                   9397: 
                   9398: sub get_user_quota {
1.1136    raeburn  9399:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  9400:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  9401:     if (!defined($udom)) {
                   9402:         $udom = $env{'user.domain'};
                   9403:     }
                   9404:     if (!defined($uname)) {
                   9405:         $uname = $env{'user.name'};
                   9406:     }
                   9407:     if (($udom eq '' || $uname eq '') ||
                   9408:         ($udom eq 'public') && ($uname eq 'public')) {
                   9409:         $quota = 0;
1.536     raeburn  9410:         $quotatype = 'default';
                   9411:         $defquota = 0; 
1.472     raeburn  9412:     } else {
1.536     raeburn  9413:         my $inststatus;
1.1134    raeburn  9414:         if ($quotaname eq 'course') {
                   9415:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   9416:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   9417:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   9418:             } else {
                   9419:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   9420:                 $quota = $cenv{'internal.uploadquota'};
                   9421:             }
1.536     raeburn  9422:         } else {
1.1134    raeburn  9423:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   9424:                 if ($quotaname eq 'author') {
                   9425:                     $quota = $env{'environment.authorquota'};
                   9426:                 } else {
                   9427:                     $quota = $env{'environment.portfolioquota'};
                   9428:                 }
                   9429:                 $inststatus = $env{'environment.inststatus'};
                   9430:             } else {
                   9431:                 my %userenv = 
                   9432:                     &Apache::lonnet::get('environment',['portfolioquota',
                   9433:                                          'authorquota','inststatus'],$udom,$uname);
                   9434:                 my ($tmp) = keys(%userenv);
                   9435:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9436:                     if ($quotaname eq 'author') {
                   9437:                         $quota = $userenv{'authorquota'};
                   9438:                     } else {
                   9439:                         $quota = $userenv{'portfolioquota'};
                   9440:                     }
                   9441:                     $inststatus = $userenv{'inststatus'};
                   9442:                 } else {
                   9443:                     undef(%userenv);
                   9444:                 }
                   9445:             }
                   9446:         }
                   9447:         if ($quota eq '' || wantarray) {
                   9448:             if ($quotaname eq 'course') {
                   9449:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  9450:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
1.1237    raeburn  9451:                     ($crstype eq 'community') || ($crstype eq 'textbook') ||
                   9452:                     ($crstype eq 'placement')) { 
1.1136    raeburn  9453:                     $defquota = $domdefs{$crstype.'quota'};
                   9454:                 }
                   9455:                 if ($defquota eq '') {
                   9456:                     $defquota = 500;
                   9457:                 }
1.1134    raeburn  9458:             } else {
                   9459:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   9460:             }
                   9461:             if ($quota eq '') {
                   9462:                 $quota = $defquota;
                   9463:                 $quotatype = 'default';
                   9464:             } else {
                   9465:                 $quotatype = 'custom';
                   9466:             }
1.472     raeburn  9467:         }
                   9468:     }
1.536     raeburn  9469:     if (wantarray) {
                   9470:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9471:     } else {
                   9472:         return $quota;
                   9473:     }
1.472     raeburn  9474: }
                   9475: 
                   9476: ###############################################
                   9477: 
                   9478: =pod
                   9479: 
                   9480: =item * &default_quota()
                   9481: 
1.536     raeburn  9482: Retrieves default quota assigned for storage of user portfolio files,
                   9483: given an (optional) user's institutional status.
1.472     raeburn  9484: 
                   9485: Incoming parameters:
1.1142    raeburn  9486: 
1.472     raeburn  9487: 1. domain
1.536     raeburn  9488: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9489:    status types (e.g., faculty, staff, student etc.)
                   9490:    which apply to the user for whom the default is being retrieved.
                   9491:    If the institutional status string in undefined, the domain
1.1134    raeburn  9492:    default quota will be returned.
                   9493: 3.  quota name - portfolio, author, or course
                   9494:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9495: 
                   9496: Returns:
1.1142    raeburn  9497: 
1.1163    raeburn  9498: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9499: 2. (Optional) institutional type which determined the value of the
                   9500:    default quota.
1.472     raeburn  9501: 
                   9502: If a value has been stored in the domain's configuration db,
                   9503: it will return that, otherwise it returns 20 (for backwards 
                   9504: compatibility with domains which have not set up a configuration
1.1163    raeburn  9505: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9506: 
1.536     raeburn  9507: If the user's status includes multiple types (e.g., staff and student),
                   9508: the largest default quota which applies to the user determines the
                   9509: default quota returned.
                   9510: 
1.472     raeburn  9511: =cut
                   9512: 
                   9513: ###############################################
                   9514: 
                   9515: 
                   9516: sub default_quota {
1.1134    raeburn  9517:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9518:     my ($defquota,$settingstatus);
                   9519:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9520:                                             ['quotas'],$udom);
1.1134    raeburn  9521:     my $key = 'defaultquota';
                   9522:     if ($quotaname eq 'author') {
                   9523:         $key = 'authorquota';
                   9524:     }
1.622     raeburn  9525:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9526:         if ($inststatus ne '') {
1.765     raeburn  9527:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9528:             foreach my $item (@statuses) {
1.1134    raeburn  9529:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9530:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9531:                         if ($defquota eq '') {
1.1134    raeburn  9532:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9533:                             $settingstatus = $item;
1.1134    raeburn  9534:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9535:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9536:                             $settingstatus = $item;
                   9537:                         }
                   9538:                     }
1.1134    raeburn  9539:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9540:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9541:                         if ($defquota eq '') {
                   9542:                             $defquota = $quotahash{'quotas'}{$item};
                   9543:                             $settingstatus = $item;
                   9544:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9545:                             $defquota = $quotahash{'quotas'}{$item};
                   9546:                             $settingstatus = $item;
                   9547:                         }
1.536     raeburn  9548:                     }
                   9549:                 }
                   9550:             }
                   9551:         }
                   9552:         if ($defquota eq '') {
1.1134    raeburn  9553:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9554:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9555:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9556:                 $defquota = $quotahash{'quotas'}{'default'};
                   9557:             }
1.536     raeburn  9558:             $settingstatus = 'default';
1.1139    raeburn  9559:             if ($defquota eq '') {
                   9560:                 if ($quotaname eq 'author') {
                   9561:                     $defquota = 500;
                   9562:                 }
                   9563:             }
1.536     raeburn  9564:         }
                   9565:     } else {
                   9566:         $settingstatus = 'default';
1.1134    raeburn  9567:         if ($quotaname eq 'author') {
                   9568:             $defquota = 500;
                   9569:         } else {
                   9570:             $defquota = 20;
                   9571:         }
1.536     raeburn  9572:     }
                   9573:     if (wantarray) {
                   9574:         return ($defquota,$settingstatus);
1.472     raeburn  9575:     } else {
1.536     raeburn  9576:         return $defquota;
1.472     raeburn  9577:     }
                   9578: }
                   9579: 
1.1135    raeburn  9580: ###############################################
                   9581: 
                   9582: =pod
                   9583: 
1.1136    raeburn  9584: =item * &excess_filesize_warning()
1.1135    raeburn  9585: 
                   9586: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  9587: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  9588: space to be exceeded.
1.1136    raeburn  9589: 
                   9590: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  9591: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  9592: 
1.1165    raeburn  9593: Inputs: 7 
1.1136    raeburn  9594: 1. username or coursenum
1.1135    raeburn  9595: 2. domain
1.1136    raeburn  9596: 3. context ('author' or 'course')
1.1135    raeburn  9597: 4. filename of file for which action is being requested
                   9598: 5. filesize (kB) of file
                   9599: 6. action being taken: copy or upload.
1.1237    raeburn  9600: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135    raeburn  9601: 
                   9602: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  9603:          otherwise return null.
                   9604: 
                   9605: =back
1.1135    raeburn  9606: 
                   9607: =cut
                   9608: 
1.1136    raeburn  9609: sub excess_filesize_warning {
1.1165    raeburn  9610:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  9611:     my $current_disk_usage = 0;
1.1165    raeburn  9612:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  9613:     if ($context eq 'author') {
                   9614:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9615:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9616:     } else {
                   9617:         foreach my $subdir ('docs','supplemental') {
                   9618:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9619:         }
                   9620:     }
1.1135    raeburn  9621:     $disk_quota = int($disk_quota * 1000);
                   9622:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   9623:         return '<p class="LC_warning">'.
1.1135    raeburn  9624:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   9625:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9626:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  9627:                             $disk_quota,$current_disk_usage).
                   9628:                '</p>';
                   9629:     }
                   9630:     return;
                   9631: }
                   9632: 
                   9633: ###############################################
                   9634: 
                   9635: 
1.1136    raeburn  9636: 
                   9637: 
1.384     raeburn  9638: sub get_secgrprole_info {
                   9639:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9640:     my %sections_count = &get_sections($cdom,$cnum);
                   9641:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9642:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9643:     my @groups = sort(keys(%curr_groups));
                   9644:     my $allroles = [];
                   9645:     my $rolehash;
                   9646:     my $accesshash = {
                   9647:                      active => 'Currently has access',
                   9648:                      future => 'Will have future access',
                   9649:                      previous => 'Previously had access',
                   9650:                   };
                   9651:     if ($needroles) {
                   9652:         $rolehash = {'all' => 'all'};
1.385     albertel 9653:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9654: 	if (&Apache::lonnet::error(%user_roles)) {
                   9655: 	    undef(%user_roles);
                   9656: 	}
                   9657:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9658:             my ($role)=split(/\:/,$item,2);
                   9659:             if ($role eq 'cr') { next; }
                   9660:             if ($role =~ /^cr/) {
                   9661:                 $$rolehash{$role} = (split('/',$role))[3];
                   9662:             } else {
                   9663:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9664:             }
                   9665:         }
                   9666:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9667:             push(@{$allroles},$key);
                   9668:         }
                   9669:         push (@{$allroles},'st');
                   9670:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9671:     }
                   9672:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9673: }
                   9674: 
1.555     raeburn  9675: sub user_picker {
1.994     raeburn  9676:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9677:     my $currdom = $dom;
                   9678:     my %curr_selected = (
                   9679:                         srchin => 'dom',
1.580     raeburn  9680:                         srchby => 'lastname',
1.555     raeburn  9681:                       );
                   9682:     my $srchterm;
1.625     raeburn  9683:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9684:         if ($srch->{'srchby'} ne '') {
                   9685:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9686:         }
                   9687:         if ($srch->{'srchin'} ne '') {
                   9688:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9689:         }
                   9690:         if ($srch->{'srchtype'} ne '') {
                   9691:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9692:         }
                   9693:         if ($srch->{'srchdomain'} ne '') {
                   9694:             $currdom = $srch->{'srchdomain'};
                   9695:         }
                   9696:         $srchterm = $srch->{'srchterm'};
                   9697:     }
1.1222    damieng  9698:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  9699:                     'usr'       => 'Search criteria',
1.563     raeburn  9700:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9701:                     'uname'     => 'username',
                   9702:                     'lastname'  => 'last name',
1.555     raeburn  9703:                     'lastfirst' => 'last name, first name',
1.558     albertel 9704:                     'crs'       => 'in this course',
1.576     raeburn  9705:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9706:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9707:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9708:                     'exact'     => 'is',
                   9709:                     'contains'  => 'contains',
1.569     raeburn  9710:                     'begins'    => 'begins with',
1.1222    damieng  9711:                                        );
                   9712:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  9713:                     'youm'      => "You must include some text to search for.",
                   9714:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9715:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9716:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9717:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9718:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9719:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9720:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9721:                                        );
1.1222    damieng  9722:     &html_escape(\%html_lt);
                   9723:     &js_escape(\%js_lt);
1.563     raeburn  9724:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9725:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9726: 
                   9727:     my @srchins = ('crs','dom','alc','instd');
                   9728: 
                   9729:     foreach my $option (@srchins) {
                   9730:         # FIXME 'alc' option unavailable until 
                   9731:         #       loncreateuser::print_user_query_page()
                   9732:         #       has been completed.
                   9733:         next if ($option eq 'alc');
1.880     raeburn  9734:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9735:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9736:         if ($curr_selected{'srchin'} eq $option) {
                   9737:             $srchinsel .= ' 
1.1222    damieng  9738:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  9739:         } else {
                   9740:             $srchinsel .= '
1.1222    damieng  9741:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  9742:         }
1.555     raeburn  9743:     }
1.563     raeburn  9744:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9745: 
                   9746:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9747:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9748:         if ($curr_selected{'srchby'} eq $option) {
                   9749:             $srchbysel .= '
1.1222    damieng  9750:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9751:         } else {
                   9752:             $srchbysel .= '
1.1222    damieng  9753:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9754:          }
                   9755:     }
                   9756:     $srchbysel .= "\n  </select>\n";
                   9757: 
                   9758:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9759:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9760:         if ($curr_selected{'srchtype'} eq $option) {
                   9761:             $srchtypesel .= '
1.1222    damieng  9762:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9763:         } else {
                   9764:             $srchtypesel .= '
1.1222    damieng  9765:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9766:         }
                   9767:     }
                   9768:     $srchtypesel .= "\n  </select>\n";
                   9769: 
1.558     albertel 9770:     my ($newuserscript,$new_user_create);
1.994     raeburn  9771:     my $context_dom = $env{'request.role.domain'};
                   9772:     if ($context eq 'requestcrs') {
                   9773:         if ($env{'form.coursedom'} ne '') { 
                   9774:             $context_dom = $env{'form.coursedom'};
                   9775:         }
                   9776:     }
1.556     raeburn  9777:     if ($forcenewuser) {
1.576     raeburn  9778:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9779:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9780:                 if ($cancreate) {
                   9781:                     $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>';
                   9782:                 } else {
1.799     bisitz   9783:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9784:                     my %usertypetext = (
                   9785:                         official   => 'institutional',
                   9786:                         unofficial => 'non-institutional',
                   9787:                     );
1.799     bisitz   9788:                     $new_user_create = '<p class="LC_warning">'
                   9789:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9790:                                       .' '
                   9791:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9792:                                           ,'<a href="'.$helplink.'">','</a>')
                   9793:                                       .'</p><br />';
1.627     raeburn  9794:                 }
1.576     raeburn  9795:             }
                   9796:         }
                   9797: 
1.556     raeburn  9798:         $newuserscript = <<"ENDSCRIPT";
                   9799: 
1.570     raeburn  9800: function setSearch(createnew,callingForm) {
1.556     raeburn  9801:     if (createnew == 1) {
1.570     raeburn  9802:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9803:             if (callingForm.srchby.options[i].value == 'uname') {
                   9804:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9805:             }
                   9806:         }
1.570     raeburn  9807:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9808:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9809: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9810:             }
                   9811:         }
1.570     raeburn  9812:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9813:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9814:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9815:             }
                   9816:         }
1.570     raeburn  9817:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9818:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9819:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9820:             }
                   9821:         }
                   9822:     }
                   9823: }
                   9824: ENDSCRIPT
1.558     albertel 9825: 
1.556     raeburn  9826:     }
                   9827: 
1.555     raeburn  9828:     my $output = <<"END_BLOCK";
1.556     raeburn  9829: <script type="text/javascript">
1.824     bisitz   9830: // <![CDATA[
1.570     raeburn  9831: function validateEntry(callingForm) {
1.558     albertel 9832: 
1.556     raeburn  9833:     var checkok = 1;
1.558     albertel 9834:     var srchin;
1.570     raeburn  9835:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9836: 	if ( callingForm.srchin[i].checked ) {
                   9837: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9838: 	}
                   9839:     }
                   9840: 
1.570     raeburn  9841:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9842:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9843:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9844:     var srchterm =  callingForm.srchterm.value;
                   9845:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9846:     var msg = "";
                   9847: 
                   9848:     if (srchterm == "") {
                   9849:         checkok = 0;
1.1222    damieng  9850:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  9851:     }
                   9852: 
1.569     raeburn  9853:     if (srchtype== 'begins') {
                   9854:         if (srchterm.length < 2) {
                   9855:             checkok = 0;
1.1222    damieng  9856:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  9857:         }
                   9858:     }
                   9859: 
1.556     raeburn  9860:     if (srchtype== 'contains') {
                   9861:         if (srchterm.length < 3) {
                   9862:             checkok = 0;
1.1222    damieng  9863:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  9864:         }
                   9865:     }
                   9866:     if (srchin == 'instd') {
                   9867:         if (srchdomain == '') {
                   9868:             checkok = 0;
1.1222    damieng  9869:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  9870:         }
                   9871:     }
                   9872:     if (srchin == 'dom') {
                   9873:         if (srchdomain == '') {
                   9874:             checkok = 0;
1.1222    damieng  9875:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  9876:         }
                   9877:     }
                   9878:     if (srchby == 'lastfirst') {
                   9879:         if (srchterm.indexOf(",") == -1) {
                   9880:             checkok = 0;
1.1222    damieng  9881:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  9882:         }
                   9883:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9884:             checkok = 0;
1.1222    damieng  9885:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  9886:         }
                   9887:     }
                   9888:     if (checkok == 0) {
1.1222    damieng  9889:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  9890:         return;
                   9891:     }
                   9892:     if (checkok == 1) {
1.570     raeburn  9893:         callingForm.submit();
1.556     raeburn  9894:     }
                   9895: }
                   9896: 
                   9897: $newuserscript
                   9898: 
1.824     bisitz   9899: // ]]>
1.556     raeburn  9900: </script>
1.558     albertel 9901: 
                   9902: $new_user_create
                   9903: 
1.555     raeburn  9904: END_BLOCK
1.558     albertel 9905: 
1.876     raeburn  9906:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222    damieng  9907:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  9908:                $domform.
                   9909:                &Apache::lonhtmlcommon::row_closure().
1.1222    damieng  9910:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  9911:                $srchbysel.
                   9912:                $srchtypesel. 
                   9913:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9914:                $srchinsel.
                   9915:                &Apache::lonhtmlcommon::row_closure(1). 
                   9916:                &Apache::lonhtmlcommon::end_pick_box().
                   9917:                '<br />';
1.555     raeburn  9918:     return $output;
                   9919: }
                   9920: 
1.612     raeburn  9921: sub user_rule_check {
1.615     raeburn  9922:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226    raeburn  9923:     my ($response,%inst_response);
1.612     raeburn  9924:     if (ref($usershash) eq 'HASH') {
1.1226    raeburn  9925:         if (keys(%{$usershash}) > 1) {
                   9926:             my (%by_username,%by_id,%userdoms);
                   9927:             my $checkid; 
                   9928:             if (ref($checks) eq 'HASH') {
                   9929:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   9930:                     $checkid = 1;
                   9931:                 }
                   9932:             }
                   9933:             foreach my $user (keys(%{$usershash})) {
                   9934:                 my ($uname,$udom) = split(/:/,$user);
                   9935:                 if ($checkid) {
                   9936:                     if (ref($usershash->{$user}) eq 'HASH') {
                   9937:                         if ($usershash->{$user}->{'id'} ne '') {
1.1227    raeburn  9938:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
1.1226    raeburn  9939:                             $userdoms{$udom} = 1;
1.1227    raeburn  9940:                             if (ref($inst_results) eq 'HASH') {
                   9941:                                 $inst_results->{$uname.':'.$udom} = {};
                   9942:                             }
1.1226    raeburn  9943:                         }
                   9944:                     }
                   9945:                 } else {
                   9946:                     $by_username{$udom}{$uname} = 1;
                   9947:                     $userdoms{$udom} = 1;
1.1227    raeburn  9948:                     if (ref($inst_results) eq 'HASH') {
                   9949:                         $inst_results->{$uname.':'.$udom} = {};
                   9950:                     }
1.1226    raeburn  9951:                 }
                   9952:             }
                   9953:             foreach my $udom (keys(%userdoms)) {
                   9954:                 if (!$got_rules->{$udom}) {
                   9955:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9956:                                                              ['usercreation'],$udom);
                   9957:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   9958:                         foreach my $item ('username','id') {
                   9959:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227    raeburn  9960:                                 $$curr_rules{$udom}{$item} =
                   9961:                                     $domconfig{'usercreation'}{$item.'_rule'};
1.1226    raeburn  9962:                             }
                   9963:                         }
                   9964:                     }
                   9965:                     $got_rules->{$udom} = 1;
                   9966:                 }
1.612     raeburn  9967:             }
1.1226    raeburn  9968:             if ($checkid) {
                   9969:                 foreach my $udom (keys(%by_id)) {
                   9970:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   9971:                     if ($outcome eq 'ok') {
1.1227    raeburn  9972:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   9973:                             my $uname = $by_id{$udom}{$id};
                   9974:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9975:                         }
1.1226    raeburn  9976:                         if (ref($results) eq 'HASH') {
                   9977:                             foreach my $uname (keys(%{$results})) {
1.1227    raeburn  9978:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   9979:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   9980:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9981:                                 }
1.1226    raeburn  9982:                             }
                   9983:                         }
                   9984:                     }
1.612     raeburn  9985:                 }
1.615     raeburn  9986:             } else {
1.1226    raeburn  9987:                 foreach my $udom (keys(%by_username)) {
                   9988:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   9989:                     if ($outcome eq 'ok') {
1.1227    raeburn  9990:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   9991:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9992:                         }
1.1226    raeburn  9993:                         if (ref($results) eq 'HASH') {
                   9994:                             foreach my $uname (keys(%{$results})) {
                   9995:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9996:                             }
                   9997:                         }
                   9998:                     }
                   9999:                 }
1.612     raeburn  10000:             }
1.1226    raeburn  10001:         } elsif (keys(%{$usershash}) == 1) {
                   10002:             my $user = (keys(%{$usershash}))[0];
                   10003:             my ($uname,$udom) = split(/:/,$user);
                   10004:             if (($udom ne '') && ($uname ne '')) {
                   10005:                 if (ref($usershash->{$user}) eq 'HASH') {
                   10006:                     if (ref($checks) eq 'HASH') {
                   10007:                         if (defined($checks->{'username'})) {
                   10008:                             ($inst_response{$user},%{$inst_results->{$user}}) = 
                   10009:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   10010:                         } elsif (defined($checks->{'id'})) {
                   10011:                             if ($usershash->{$user}->{'id'} ne '') {
                   10012:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10013:                                     &Apache::lonnet::get_instuser($udom,undef,
                   10014:                                                                   $usershash->{$user}->{'id'});
                   10015:                             } else {
                   10016:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10017:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   10018:                             }
1.585     raeburn  10019:                         }
1.1226    raeburn  10020:                     } else {
                   10021:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   10022:                             &Apache::lonnet::get_instuser($udom,$uname);
                   10023:                        return;
                   10024:                     }
                   10025:                     if (!$got_rules->{$udom}) {
                   10026:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10027:                                                                  ['usercreation'],$udom);
                   10028:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10029:                             foreach my $item ('username','id') {
                   10030:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10031:                                    $$curr_rules{$udom}{$item} = 
                   10032:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   10033:                                 }
                   10034:                             }
                   10035:                         }
                   10036:                         $got_rules->{$udom} = 1;
1.585     raeburn  10037:                     }
                   10038:                 }
1.1226    raeburn  10039:             } else {
                   10040:                 return;
                   10041:             }
                   10042:         } else {
                   10043:             return;
                   10044:         }
                   10045:         foreach my $user (keys(%{$usershash})) {
                   10046:             my ($uname,$udom) = split(/:/,$user);
                   10047:             next if (($udom eq '') || ($uname eq ''));
                   10048:             my $id;
1.1227    raeburn  10049:             if (ref($inst_results) eq 'HASH') {
                   10050:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   10051:                     $id = $inst_results->{$user}->{'id'};
                   10052:                 }
                   10053:             }
                   10054:             if ($id eq '') { 
                   10055:                 if (ref($usershash->{$user})) {
                   10056:                     $id = $usershash->{$user}->{'id'};
                   10057:                 }
1.585     raeburn  10058:             }
1.612     raeburn  10059:             foreach my $item (keys(%{$checks})) {
                   10060:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   10061:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   10062:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226    raeburn  10063:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   10064:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  10065:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   10066:                                 if ($rule_check{$rule}) {
                   10067:                                     $$rulematch{$user}{$item} = $rule;
1.1226    raeburn  10068:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  10069:                                         if (ref($inst_results) eq 'HASH') {
                   10070:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   10071:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   10072:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1227    raeburn  10073:                                                 } elsif ($item eq 'id') {
                   10074:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   10075:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   10076:                                                     }
1.615     raeburn  10077:                                                 }
1.612     raeburn  10078:                                             }
                   10079:                                         }
1.615     raeburn  10080:                                     }
                   10081:                                     last;
1.585     raeburn  10082:                                 }
                   10083:                             }
                   10084:                         }
                   10085:                     }
                   10086:                 }
                   10087:             }
                   10088:         }
                   10089:     }
1.612     raeburn  10090:     return;
                   10091: }
                   10092: 
                   10093: sub user_rule_formats {
                   10094:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   10095:     my %text = ( 
                   10096:                  'username' => 'Usernames',
                   10097:                  'id'       => 'IDs',
                   10098:                );
                   10099:     my $output;
                   10100:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   10101:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   10102:         if (@{$ruleorder} > 0) {
1.1102    raeburn  10103:             $output = '<br />'.
                   10104:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   10105:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   10106:                       ' <ul>';
1.612     raeburn  10107:             foreach my $rule (@{$ruleorder}) {
                   10108:                 if (ref($curr_rules) eq 'ARRAY') {
                   10109:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   10110:                         if (ref($rules->{$rule}) eq 'HASH') {
                   10111:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   10112:                                         $rules->{$rule}{'desc'}.'</li>';
                   10113:                         }
                   10114:                     }
                   10115:                 }
                   10116:             }
                   10117:             $output .= '</ul>';
                   10118:         }
                   10119:     }
                   10120:     return $output;
                   10121: }
                   10122: 
                   10123: sub instrule_disallow_msg {
1.615     raeburn  10124:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  10125:     my $response;
                   10126:     my %text = (
                   10127:                   item   => 'username',
                   10128:                   items  => 'usernames',
                   10129:                   match  => 'matches',
                   10130:                   do     => 'does',
                   10131:                   action => 'a username',
                   10132:                   one    => 'one',
                   10133:                );
                   10134:     if ($count > 1) {
                   10135:         $text{'item'} = 'usernames';
                   10136:         $text{'match'} ='match';
                   10137:         $text{'do'} = 'do';
                   10138:         $text{'action'} = 'usernames',
                   10139:         $text{'one'} = 'ones';
                   10140:     }
                   10141:     if ($checkitem eq 'id') {
                   10142:         $text{'items'} = 'IDs';
                   10143:         $text{'item'} = 'ID';
                   10144:         $text{'action'} = 'an ID';
1.615     raeburn  10145:         if ($count > 1) {
                   10146:             $text{'item'} = 'IDs';
                   10147:             $text{'action'} = 'IDs';
                   10148:         }
1.612     raeburn  10149:     }
1.674     bisitz   10150:     $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  10151:     if ($mode eq 'upload') {
                   10152:         if ($checkitem eq 'username') {
                   10153:             $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'}.");
                   10154:         } elsif ($checkitem eq 'id') {
1.674     bisitz   10155:             $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  10156:         }
1.669     raeburn  10157:     } elsif ($mode eq 'selfcreate') {
                   10158:         if ($checkitem eq 'id') {
                   10159:             $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.");
                   10160:         }
1.615     raeburn  10161:     } else {
                   10162:         if ($checkitem eq 'username') {
                   10163:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   10164:         } elsif ($checkitem eq 'id') {
                   10165:             $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.");
                   10166:         }
1.612     raeburn  10167:     }
                   10168:     return $response;
1.585     raeburn  10169: }
                   10170: 
1.624     raeburn  10171: sub personal_data_fieldtitles {
                   10172:     my %fieldtitles = &Apache::lonlocal::texthash (
                   10173:                         id => 'Student/Employee ID',
                   10174:                         permanentemail => 'E-mail address',
                   10175:                         lastname => 'Last Name',
                   10176:                         firstname => 'First Name',
                   10177:                         middlename => 'Middle Name',
                   10178:                         generation => 'Generation',
                   10179:                         gen => 'Generation',
1.765     raeburn  10180:                         inststatus => 'Affiliation',
1.624     raeburn  10181:                    );
                   10182:     return %fieldtitles;
                   10183: }
                   10184: 
1.642     raeburn  10185: sub sorted_inst_types {
                   10186:     my ($dom) = @_;
1.1185    raeburn  10187:     my ($usertypes,$order);
                   10188:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   10189:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   10190:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   10191:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   10192:     } else {
                   10193:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   10194:     }
1.642     raeburn  10195:     my $othertitle = &mt('All users');
                   10196:     if ($env{'request.course.id'}) {
1.668     raeburn  10197:         $othertitle  = &mt('Any users');
1.642     raeburn  10198:     }
                   10199:     my @types;
                   10200:     if (ref($order) eq 'ARRAY') {
                   10201:         @types = @{$order};
                   10202:     }
                   10203:     if (@types == 0) {
                   10204:         if (ref($usertypes) eq 'HASH') {
                   10205:             @types = sort(keys(%{$usertypes}));
                   10206:         }
                   10207:     }
                   10208:     if (keys(%{$usertypes}) > 0) {
                   10209:         $othertitle = &mt('Other users');
                   10210:     }
                   10211:     return ($othertitle,$usertypes,\@types);
                   10212: }
                   10213: 
1.645     raeburn  10214: sub get_institutional_codes {
                   10215:     my ($settings,$allcourses,$LC_code) = @_;
                   10216: # Get complete list of course sections to update
                   10217:     my @currsections = ();
                   10218:     my @currxlists = ();
                   10219:     my $coursecode = $$settings{'internal.coursecode'};
                   10220: 
                   10221:     if ($$settings{'internal.sectionnums'} ne '') {
                   10222:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   10223:     }
                   10224: 
                   10225:     if ($$settings{'internal.crosslistings'} ne '') {
                   10226:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   10227:     }
                   10228: 
                   10229:     if (@currxlists > 0) {
                   10230:         foreach (@currxlists) {
                   10231:             if (m/^([^:]+):(\w*)$/) {
                   10232:                 unless (grep/^$1$/,@{$allcourses}) {
                   10233:                     push @{$allcourses},$1;
                   10234:                     $$LC_code{$1} = $2;
                   10235:                 }
                   10236:             }
                   10237:         }
                   10238:     }
                   10239:  
                   10240:     if (@currsections > 0) {
                   10241:         foreach (@currsections) {
                   10242:             if (m/^(\w+):(\w*)$/) {
                   10243:                 my $sec = $coursecode.$1;
                   10244:                 my $lc_sec = $2;
                   10245:                 unless (grep/^$sec$/,@{$allcourses}) {
                   10246:                     push @{$allcourses},$sec;
                   10247:                     $$LC_code{$sec} = $lc_sec;
                   10248:                 }
                   10249:             }
                   10250:         }
                   10251:     }
                   10252:     return;
                   10253: }
                   10254: 
1.971     raeburn  10255: sub get_standard_codeitems {
                   10256:     return ('Year','Semester','Department','Number','Section');
                   10257: }
                   10258: 
1.112     bowersj2 10259: =pod
                   10260: 
1.780     raeburn  10261: =head1 Slot Helpers
                   10262: 
                   10263: =over 4
                   10264: 
                   10265: =item * sorted_slots()
                   10266: 
1.1040    raeburn  10267: Sorts an array of slot names in order of an optional sort key,
                   10268: default sort is by slot start time (earliest first). 
1.780     raeburn  10269: 
                   10270: Inputs:
                   10271: 
                   10272: =over 4
                   10273: 
                   10274: slotsarr  - Reference to array of unsorted slot names.
                   10275: 
                   10276: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   10277: 
1.1040    raeburn  10278: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   10279: 
1.549     albertel 10280: =back
                   10281: 
1.780     raeburn  10282: Returns:
                   10283: 
                   10284: =over 4
                   10285: 
1.1040    raeburn  10286: sorted   - An array of slot names sorted by a specified sort key 
                   10287:            (default sort key is start time of the slot).
1.780     raeburn  10288: 
                   10289: =back
                   10290: 
                   10291: =cut
                   10292: 
                   10293: 
                   10294: sub sorted_slots {
1.1040    raeburn  10295:     my ($slotsarr,$slots,$sortkey) = @_;
                   10296:     if ($sortkey eq '') {
                   10297:         $sortkey = 'starttime';
                   10298:     }
1.780     raeburn  10299:     my @sorted;
                   10300:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   10301:         @sorted =
                   10302:             sort {
                   10303:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  10304:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  10305:                      }
                   10306:                      if (ref($slots->{$a})) { return -1;}
                   10307:                      if (ref($slots->{$b})) { return 1;}
                   10308:                      return 0;
                   10309:                  } @{$slotsarr};
                   10310:     }
                   10311:     return @sorted;
                   10312: }
                   10313: 
1.1040    raeburn  10314: =pod
                   10315: 
                   10316: =item * get_future_slots()
                   10317: 
                   10318: Inputs:
                   10319: 
                   10320: =over 4
                   10321: 
                   10322: cnum - course number
                   10323: 
                   10324: cdom - course domain
                   10325: 
                   10326: now - current UNIX time
                   10327: 
                   10328: symb - optional symb
                   10329: 
                   10330: =back
                   10331: 
                   10332: Returns:
                   10333: 
                   10334: =over 4
                   10335: 
                   10336: sorted_reservable - ref to array of student_schedulable slots currently 
                   10337:                     reservable, ordered by end date of reservation period.
                   10338: 
                   10339: reservable_now - ref to hash of student_schedulable slots currently
                   10340:                  reservable.
                   10341: 
                   10342:     Keys in inner hash are:
                   10343:     (a) symb: either blank or symb to which slot use is restricted.
                   10344:     (b) endreserve: end date of reservation period. 
                   10345: 
                   10346: sorted_future - ref to array of student_schedulable slots reservable in
                   10347:                 the future, ordered by start date of reservation period.
                   10348: 
                   10349: future_reservable - ref to hash of student_schedulable slots reservable
                   10350:                     in the future.
                   10351: 
                   10352:     Keys in inner hash are:
                   10353:     (a) symb: either blank or symb to which slot use is restricted.
                   10354:     (b) startreserve:  start date of reservation period.
                   10355: 
                   10356: =back
                   10357: 
                   10358: =cut
                   10359: 
                   10360: sub get_future_slots {
                   10361:     my ($cnum,$cdom,$now,$symb) = @_;
1.1229    raeburn  10362:     my $map;
                   10363:     if ($symb) {
                   10364:         ($map) = &Apache::lonnet::decode_symb($symb);
                   10365:     }
1.1040    raeburn  10366:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   10367:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   10368:     foreach my $slot (keys(%slots)) {
                   10369:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   10370:         if ($symb) {
1.1229    raeburn  10371:             if ($slots{$slot}->{'symb'} ne '') {
                   10372:                 my $canuse;
                   10373:                 my %oksymbs;
                   10374:                 my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   10375:                 map { $oksymbs{$_} = 1; } @slotsymbs;
                   10376:                 if ($oksymbs{$symb}) {
                   10377:                     $canuse = 1;
                   10378:                 } else {
                   10379:                     foreach my $item (@slotsymbs) {
                   10380:                         if ($item =~ /\.(page|sequence)$/) {
                   10381:                             (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                   10382:                             if (($map ne '') && ($map eq $sloturl)) {
                   10383:                                 $canuse = 1;
                   10384:                                 last;
                   10385:                             }
                   10386:                         }
                   10387:                     }
                   10388:                 }
                   10389:                 next unless ($canuse);
                   10390:             }
1.1040    raeburn  10391:         }
                   10392:         if (($slots{$slot}->{'starttime'} > $now) &&
                   10393:             ($slots{$slot}->{'endtime'} > $now)) {
                   10394:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   10395:                 my $userallowed = 0;
                   10396:                 if ($slots{$slot}->{'allowedsections'}) {
                   10397:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   10398:                     if (!defined($env{'request.role.sec'})
                   10399:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   10400:                         $userallowed=1;
                   10401:                     } else {
                   10402:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   10403:                             $userallowed=1;
                   10404:                         }
                   10405:                     }
                   10406:                     unless ($userallowed) {
                   10407:                         if (defined($env{'request.course.groups'})) {
                   10408:                             my @groups = split(/:/,$env{'request.course.groups'});
                   10409:                             foreach my $group (@groups) {
                   10410:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   10411:                                     $userallowed=1;
                   10412:                                     last;
                   10413:                                 }
                   10414:                             }
                   10415:                         }
                   10416:                     }
                   10417:                 }
                   10418:                 if ($slots{$slot}->{'allowedusers'}) {
                   10419:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   10420:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   10421:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   10422:                         $userallowed = 1;
                   10423:                     }
                   10424:                 }
                   10425:                 next unless($userallowed);
                   10426:             }
                   10427:             my $startreserve = $slots{$slot}->{'startreserve'};
                   10428:             my $endreserve = $slots{$slot}->{'endreserve'};
                   10429:             my $symb = $slots{$slot}->{'symb'};
                   10430:             if (($startreserve < $now) &&
                   10431:                 (!$endreserve || $endreserve > $now)) {
                   10432:                 my $lastres = $endreserve;
                   10433:                 if (!$lastres) {
                   10434:                     $lastres = $slots{$slot}->{'starttime'};
                   10435:                 }
                   10436:                 $reservable_now{$slot} = {
                   10437:                                            symb       => $symb,
                   10438:                                            endreserve => $lastres
                   10439:                                          };
                   10440:             } elsif (($startreserve > $now) &&
                   10441:                      (!$endreserve || $endreserve > $startreserve)) {
                   10442:                 $future_reservable{$slot} = {
                   10443:                                               symb         => $symb,
                   10444:                                               startreserve => $startreserve
                   10445:                                             };
                   10446:             }
                   10447:         }
                   10448:     }
                   10449:     my @unsorted_reservable = keys(%reservable_now);
                   10450:     if (@unsorted_reservable > 0) {
                   10451:         @sorted_reservable = 
                   10452:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   10453:     }
                   10454:     my @unsorted_future = keys(%future_reservable);
                   10455:     if (@unsorted_future > 0) {
                   10456:         @sorted_future =
                   10457:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   10458:     }
                   10459:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   10460: }
1.780     raeburn  10461: 
                   10462: =pod
                   10463: 
1.1057    foxr     10464: =back
                   10465: 
1.549     albertel 10466: =head1 HTTP Helpers
                   10467: 
                   10468: =over 4
                   10469: 
1.648     raeburn  10470: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 10471: 
1.258     albertel 10472: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 10473: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 10474: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 10475: 
                   10476: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   10477: $possible_names is an ref to an array of form element names.  As an example:
                   10478: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 10479: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 10480: 
                   10481: =cut
1.1       albertel 10482: 
1.6       albertel 10483: sub get_unprocessed_cgi {
1.25      albertel 10484:   my ($query,$possible_names)= @_;
1.26      matthew  10485:   # $Apache::lonxml::debug=1;
1.356     albertel 10486:   foreach my $pair (split(/&/,$query)) {
                   10487:     my ($name, $value) = split(/=/,$pair);
1.369     www      10488:     $name = &unescape($name);
1.25      albertel 10489:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   10490:       $value =~ tr/+/ /;
                   10491:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10492:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10493:     }
1.16      harris41 10494:   }
1.6       albertel 10495: }
                   10496: 
1.112     bowersj2 10497: =pod
                   10498: 
1.648     raeburn  10499: =item * &cacheheader() 
1.112     bowersj2 10500: 
                   10501: returns cache-controlling header code
                   10502: 
                   10503: =cut
                   10504: 
1.7       albertel 10505: sub cacheheader {
1.258     albertel 10506:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10507:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10508:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10509:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10510:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10511:     return $output;
1.7       albertel 10512: }
                   10513: 
1.112     bowersj2 10514: =pod
                   10515: 
1.648     raeburn  10516: =item * &no_cache($r) 
1.112     bowersj2 10517: 
                   10518: specifies header code to not have cache
                   10519: 
                   10520: =cut
                   10521: 
1.9       albertel 10522: sub no_cache {
1.216     albertel 10523:     my ($r) = @_;
                   10524:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10525: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10526:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10527:     $r->no_cache(1);
                   10528:     $r->header_out("Expires" => $date);
                   10529:     $r->header_out("Pragma" => "no-cache");
1.123     www      10530: }
                   10531: 
                   10532: sub content_type {
1.181     albertel 10533:     my ($r,$type,$charset) = @_;
1.299     foxr     10534:     if ($r) {
                   10535: 	#  Note that printout.pl calls this with undef for $r.
                   10536: 	&no_cache($r);
                   10537:     }
1.258     albertel 10538:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10539:     unless ($charset) {
                   10540: 	$charset=&Apache::lonlocal::current_encoding;
                   10541:     }
                   10542:     if ($charset) { $type.='; charset='.$charset; }
                   10543:     if ($r) {
                   10544: 	$r->content_type($type);
                   10545:     } else {
                   10546: 	print("Content-type: $type\n\n");
                   10547:     }
1.9       albertel 10548: }
1.25      albertel 10549: 
1.112     bowersj2 10550: =pod
                   10551: 
1.648     raeburn  10552: =item * &add_to_env($name,$value) 
1.112     bowersj2 10553: 
1.258     albertel 10554: adds $name to the %env hash with value
1.112     bowersj2 10555: $value, if $name already exists, the entry is converted to an array
                   10556: reference and $value is added to the array.
                   10557: 
                   10558: =cut
                   10559: 
1.25      albertel 10560: sub add_to_env {
                   10561:   my ($name,$value)=@_;
1.258     albertel 10562:   if (defined($env{$name})) {
                   10563:     if (ref($env{$name})) {
1.25      albertel 10564:       #already have multiple values
1.258     albertel 10565:       push(@{ $env{$name} },$value);
1.25      albertel 10566:     } else {
                   10567:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 10568:       my $first=$env{$name};
                   10569:       undef($env{$name});
                   10570:       push(@{ $env{$name} },$first,$value);
1.25      albertel 10571:     }
                   10572:   } else {
1.258     albertel 10573:     $env{$name}=$value;
1.25      albertel 10574:   }
1.31      albertel 10575: }
1.149     albertel 10576: 
                   10577: =pod
                   10578: 
1.648     raeburn  10579: =item * &get_env_multiple($name) 
1.149     albertel 10580: 
1.258     albertel 10581: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 10582: values may be defined and end up as an array ref.
                   10583: 
                   10584: returns an array of values
                   10585: 
                   10586: =cut
                   10587: 
                   10588: sub get_env_multiple {
                   10589:     my ($name) = @_;
                   10590:     my @values;
1.258     albertel 10591:     if (defined($env{$name})) {
1.149     albertel 10592:         # exists is it an array
1.258     albertel 10593:         if (ref($env{$name})) {
                   10594:             @values=@{ $env{$name} };
1.149     albertel 10595:         } else {
1.258     albertel 10596:             $values[0]=$env{$name};
1.149     albertel 10597:         }
                   10598:     }
                   10599:     return(@values);
                   10600: }
                   10601: 
1.660     raeburn  10602: sub ask_for_embedded_content {
                   10603:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  10604:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  10605:         %currsubfile,%unused,$rem);
1.1071    raeburn  10606:     my $counter = 0;
                   10607:     my $numnew = 0;
1.987     raeburn  10608:     my $numremref = 0;
                   10609:     my $numinvalid = 0;
                   10610:     my $numpathchg = 0;
                   10611:     my $numexisting = 0;
1.1071    raeburn  10612:     my $numunused = 0;
                   10613:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  10614:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  10615:     my $heading = &mt('Upload embedded files');
                   10616:     my $buttontext = &mt('Upload');
                   10617: 
1.1085    raeburn  10618:     if ($env{'request.course.id'}) {
1.1123    raeburn  10619:         if ($actionurl eq '/adm/dependencies') {
                   10620:             $navmap = Apache::lonnavmaps::navmap->new();
                   10621:         }
                   10622:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   10623:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  10624:     }
1.1123    raeburn  10625:     if (($actionurl eq '/adm/portfolio') || 
                   10626:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  10627:         my $current_path='/';
                   10628:         if ($env{'form.currentpath'}) {
                   10629:             $current_path = $env{'form.currentpath'};
                   10630:         }
                   10631:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  10632:             $udom = $cdom;
                   10633:             $uname = $cnum;
1.984     raeburn  10634:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   10635:         } else {
                   10636:             $udom = $env{'user.domain'};
                   10637:             $uname = $env{'user.name'};
                   10638:             $url = '/userfiles/portfolio';
                   10639:         }
1.987     raeburn  10640:         $toplevel = $url.'/';
1.984     raeburn  10641:         $url .= $current_path;
                   10642:         $getpropath = 1;
1.987     raeburn  10643:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   10644:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      10645:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  10646:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  10647:         $toplevel = $url;
1.984     raeburn  10648:         if ($rest ne '') {
1.987     raeburn  10649:             $url .= $rest;
                   10650:         }
                   10651:     } elsif ($actionurl eq '/adm/coursedocs') {
                   10652:         if (ref($args) eq 'HASH') {
1.1071    raeburn  10653:             $url = $args->{'docs_url'};
                   10654:             $toplevel = $url;
1.1084    raeburn  10655:             if ($args->{'context'} eq 'paste') {
                   10656:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   10657:                 ($path) = 
                   10658:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10659:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10660:                 $fileloc =~ s{^/}{};
                   10661:             }
1.1071    raeburn  10662:         }
1.1084    raeburn  10663:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  10664:         if ($env{'request.course.id'} ne '') {
                   10665:             if (ref($args) eq 'HASH') {
                   10666:                 $url = $args->{'docs_url'};
                   10667:                 $title = $args->{'docs_title'};
1.1126    raeburn  10668:                 $toplevel = $url; 
                   10669:                 unless ($toplevel =~ m{^/}) {
                   10670:                     $toplevel = "/$url";
                   10671:                 }
1.1085    raeburn  10672:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  10673:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   10674:                     $path = $1;
                   10675:                 } else {
                   10676:                     ($path) =
                   10677:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10678:                 }
1.1195    raeburn  10679:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   10680:                     $fileloc = $toplevel;
                   10681:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   10682:                     my ($udom,$uname,$fname) =
                   10683:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   10684:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   10685:                 } else {
                   10686:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10687:                 }
1.1071    raeburn  10688:                 $fileloc =~ s{^/}{};
                   10689:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   10690:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   10691:             }
1.987     raeburn  10692:         }
1.1123    raeburn  10693:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10694:         $udom = $cdom;
                   10695:         $uname = $cnum;
                   10696:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   10697:         $toplevel = $url;
                   10698:         $path = $url;
                   10699:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   10700:         $fileloc =~ s{^/}{};
1.987     raeburn  10701:     }
1.1126    raeburn  10702:     foreach my $file (keys(%{$allfiles})) {
                   10703:         my $embed_file;
                   10704:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   10705:             $embed_file = $1;
                   10706:         } else {
                   10707:             $embed_file = $file;
                   10708:         }
1.1158    raeburn  10709:         my ($absolutepath,$cleaned_file);
                   10710:         if ($embed_file =~ m{^\w+://}) {
                   10711:             $cleaned_file = $embed_file;
1.1147    raeburn  10712:             $newfiles{$cleaned_file} = 1;
                   10713:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10714:         } else {
1.1158    raeburn  10715:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  10716:             if ($embed_file =~ m{^/}) {
                   10717:                 $absolutepath = $embed_file;
                   10718:             }
1.1147    raeburn  10719:             if ($cleaned_file =~ m{/}) {
                   10720:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  10721:                 $path = &check_for_traversal($path,$url,$toplevel);
                   10722:                 my $item = $fname;
                   10723:                 if ($path ne '') {
                   10724:                     $item = $path.'/'.$fname;
                   10725:                     $subdependencies{$path}{$fname} = 1;
                   10726:                 } else {
                   10727:                     $dependencies{$item} = 1;
                   10728:                 }
                   10729:                 if ($absolutepath) {
                   10730:                     $mapping{$item} = $absolutepath;
                   10731:                 } else {
                   10732:                     $mapping{$item} = $embed_file;
                   10733:                 }
                   10734:             } else {
                   10735:                 $dependencies{$embed_file} = 1;
                   10736:                 if ($absolutepath) {
1.1147    raeburn  10737:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  10738:                 } else {
1.1147    raeburn  10739:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10740:                 }
                   10741:             }
1.984     raeburn  10742:         }
                   10743:     }
1.1071    raeburn  10744:     my $dirptr = 16384;
1.984     raeburn  10745:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  10746:         $currsubfile{$path} = {};
1.1123    raeburn  10747:         if (($actionurl eq '/adm/portfolio') || 
                   10748:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10749:             my ($sublistref,$listerror) =
                   10750:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   10751:             if (ref($sublistref) eq 'ARRAY') {
                   10752:                 foreach my $line (@{$sublistref}) {
                   10753:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  10754:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  10755:                 }
1.984     raeburn  10756:             }
1.987     raeburn  10757:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10758:             if (opendir(my $dir,$url.'/'.$path)) {
                   10759:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  10760:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   10761:             }
1.1084    raeburn  10762:         } elsif (($actionurl eq '/adm/dependencies') ||
                   10763:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10764:                   ($args->{'context'} eq 'paste')) ||
                   10765:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10766:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  10767:                 my $dir;
                   10768:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10769:                     $dir = $fileloc;
                   10770:                 } else {
                   10771:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10772:                 }
1.1071    raeburn  10773:                 if ($dir ne '') {
                   10774:                     my ($sublistref,$listerror) =
                   10775:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10776:                     if (ref($sublistref) eq 'ARRAY') {
                   10777:                         foreach my $line (@{$sublistref}) {
                   10778:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10779:                                 undef,$mtime)=split(/\&/,$line,12);
                   10780:                             unless (($testdir&$dirptr) ||
                   10781:                                     ($file_name =~ /^\.\.?$/)) {
                   10782:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10783:                             }
                   10784:                         }
                   10785:                     }
                   10786:                 }
1.984     raeburn  10787:             }
                   10788:         }
                   10789:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10790:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10791:                 my $item = $path.'/'.$file;
                   10792:                 unless ($mapping{$item} eq $item) {
                   10793:                     $pathchanges{$item} = 1;
                   10794:                 }
                   10795:                 $existing{$item} = 1;
                   10796:                 $numexisting ++;
                   10797:             } else {
                   10798:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10799:             }
                   10800:         }
1.1071    raeburn  10801:         if ($actionurl eq '/adm/dependencies') {
                   10802:             foreach my $path (keys(%currsubfile)) {
                   10803:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10804:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10805:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  10806:                              next if (($rem ne '') &&
                   10807:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10808:                                        (ref($navmap) &&
                   10809:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10810:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10811:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10812:                              $unused{$path.'/'.$file} = 1; 
                   10813:                          }
                   10814:                     }
                   10815:                 }
                   10816:             }
                   10817:         }
1.984     raeburn  10818:     }
1.987     raeburn  10819:     my %currfile;
1.1123    raeburn  10820:     if (($actionurl eq '/adm/portfolio') ||
                   10821:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10822:         my ($dirlistref,$listerror) =
                   10823:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10824:         if (ref($dirlistref) eq 'ARRAY') {
                   10825:             foreach my $line (@{$dirlistref}) {
                   10826:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10827:                 $currfile{$file_name} = 1;
                   10828:             }
1.984     raeburn  10829:         }
1.987     raeburn  10830:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10831:         if (opendir(my $dir,$url)) {
1.987     raeburn  10832:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10833:             map {$currfile{$_} = 1;} @dir_list;
                   10834:         }
1.1084    raeburn  10835:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10836:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10837:               ($args->{'context'} eq 'paste')) ||
                   10838:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10839:         if ($env{'request.course.id'} ne '') {
                   10840:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10841:             if ($dir ne '') {
                   10842:                 my ($dirlistref,$listerror) =
                   10843:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10844:                 if (ref($dirlistref) eq 'ARRAY') {
                   10845:                     foreach my $line (@{$dirlistref}) {
                   10846:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10847:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10848:                         unless (($testdir&$dirptr) ||
                   10849:                                 ($file_name =~ /^\.\.?$/)) {
                   10850:                             $currfile{$file_name} = [$size,$mtime];
                   10851:                         }
                   10852:                     }
                   10853:                 }
                   10854:             }
                   10855:         }
1.984     raeburn  10856:     }
                   10857:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10858:         if (exists($currfile{$file})) {
1.987     raeburn  10859:             unless ($mapping{$file} eq $file) {
                   10860:                 $pathchanges{$file} = 1;
                   10861:             }
                   10862:             $existing{$file} = 1;
                   10863:             $numexisting ++;
                   10864:         } else {
1.984     raeburn  10865:             $newfiles{$file} = 1;
                   10866:         }
                   10867:     }
1.1071    raeburn  10868:     foreach my $file (keys(%currfile)) {
                   10869:         unless (($file eq $filename) ||
                   10870:                 ($file eq $filename.'.bak') ||
                   10871:                 ($dependencies{$file})) {
1.1085    raeburn  10872:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10873:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10874:                     next if (($rem ne '') &&
                   10875:                              (($env{"httpref.$rem".$file} ne '') ||
                   10876:                               (ref($navmap) &&
                   10877:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10878:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10879:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10880:                 }
1.1085    raeburn  10881:             }
1.1071    raeburn  10882:             $unused{$file} = 1;
                   10883:         }
                   10884:     }
1.1084    raeburn  10885:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10886:         ($args->{'context'} eq 'paste')) {
                   10887:         $counter = scalar(keys(%existing));
                   10888:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10889:         return ($output,$counter,$numpathchg,\%existing);
                   10890:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10891:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10892:         $counter = scalar(keys(%existing));
                   10893:         $numpathchg = scalar(keys(%pathchanges));
                   10894:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10895:     }
1.984     raeburn  10896:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10897:         if ($actionurl eq '/adm/dependencies') {
                   10898:             next if ($embed_file =~ m{^\w+://});
                   10899:         }
1.660     raeburn  10900:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10901:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10902:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10903:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10904:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10905:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10906:         }
1.1123    raeburn  10907:         $upload_output .= '</td>';
1.1071    raeburn  10908:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10909:             $upload_output.='<td align="right">'.
                   10910:                             '<span class="LC_info LC_fontsize_medium">'.
                   10911:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10912:             $numremref++;
1.660     raeburn  10913:         } elsif ($args->{'error_on_invalid_names'}
                   10914:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10915:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10916:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10917:             $numinvalid++;
1.660     raeburn  10918:         } else {
1.1123    raeburn  10919:             $upload_output .= '<td>'.
                   10920:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10921:                                                      $embed_file,\%mapping,
1.1071    raeburn  10922:                                                      $allfiles,$codebase,'upload');
                   10923:             $counter ++;
                   10924:             $numnew ++;
1.987     raeburn  10925:         }
                   10926:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10927:     }
                   10928:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10929:         if ($actionurl eq '/adm/dependencies') {
                   10930:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10931:             $modify_output .= &start_data_table_row().
                   10932:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10933:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10934:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10935:                               '<td>'.$size.'</td>'.
                   10936:                               '<td>'.$mtime.'</td>'.
                   10937:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10938:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10939:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10940:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10941:                               &embedded_file_element('upload_embedded',$counter,
                   10942:                                                      $embed_file,\%mapping,
                   10943:                                                      $allfiles,$codebase,'modify').
                   10944:                               '</div></td>'.
                   10945:                               &end_data_table_row()."\n";
                   10946:             $counter ++;
                   10947:         } else {
                   10948:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10949:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10950:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10951:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10952:                               &Apache::loncommon::end_data_table_row()."\n";
                   10953:         }
                   10954:     }
                   10955:     my $delidx = $counter;
                   10956:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10957:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10958:         $delete_output .= &start_data_table_row().
                   10959:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10960:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10961:                           '<td>'.$size.'</td>'.
                   10962:                           '<td>'.$mtime.'</td>'.
                   10963:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10964:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10965:                           &embedded_file_element('upload_embedded',$delidx,
                   10966:                                                  $oldfile,\%mapping,$allfiles,
                   10967:                                                  $codebase,'delete').'</td>'.
                   10968:                           &end_data_table_row()."\n"; 
                   10969:         $numunused ++;
                   10970:         $delidx ++;
1.987     raeburn  10971:     }
                   10972:     if ($upload_output) {
                   10973:         $upload_output = &start_data_table().
                   10974:                          $upload_output.
                   10975:                          &end_data_table()."\n";
                   10976:     }
1.1071    raeburn  10977:     if ($modify_output) {
                   10978:         $modify_output = &start_data_table().
                   10979:                          &start_data_table_header_row().
                   10980:                          '<th>'.&mt('File').'</th>'.
                   10981:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10982:                          '<th>'.&mt('Modified').'</th>'.
                   10983:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10984:                          &end_data_table_header_row().
                   10985:                          $modify_output.
                   10986:                          &end_data_table()."\n";
                   10987:     }
                   10988:     if ($delete_output) {
                   10989:         $delete_output = &start_data_table().
                   10990:                          &start_data_table_header_row().
                   10991:                          '<th>'.&mt('File').'</th>'.
                   10992:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10993:                          '<th>'.&mt('Modified').'</th>'.
                   10994:                          '<th>'.&mt('Delete?').'</th>'.
                   10995:                          &end_data_table_header_row().
                   10996:                          $delete_output.
                   10997:                          &end_data_table()."\n";
                   10998:     }
1.987     raeburn  10999:     my $applies = 0;
                   11000:     if ($numremref) {
                   11001:         $applies ++;
                   11002:     }
                   11003:     if ($numinvalid) {
                   11004:         $applies ++;
                   11005:     }
                   11006:     if ($numexisting) {
                   11007:         $applies ++;
                   11008:     }
1.1071    raeburn  11009:     if ($counter || $numunused) {
1.987     raeburn  11010:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   11011:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  11012:                   $state.'<h3>'.$heading.'</h3>'; 
                   11013:         if ($actionurl eq '/adm/dependencies') {
                   11014:             if ($numnew) {
                   11015:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   11016:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   11017:                            $upload_output.'<br />'."\n";
                   11018:             }
                   11019:             if ($numexisting) {
                   11020:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   11021:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   11022:                            $modify_output.'<br />'."\n";
                   11023:                            $buttontext = &mt('Save changes');
                   11024:             }
                   11025:             if ($numunused) {
                   11026:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   11027:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   11028:                            $delete_output.'<br />'."\n";
                   11029:                            $buttontext = &mt('Save changes');
                   11030:             }
                   11031:         } else {
                   11032:             $output .= $upload_output.'<br />'."\n";
                   11033:         }
                   11034:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   11035:                    $counter.'" />'."\n";
                   11036:         if ($actionurl eq '/adm/dependencies') { 
                   11037:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   11038:                        $numnew.'" />'."\n";
                   11039:         } elsif ($actionurl eq '') {
1.987     raeburn  11040:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   11041:         }
                   11042:     } elsif ($applies) {
                   11043:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   11044:         if ($applies > 1) {
                   11045:             $output .=  
1.1123    raeburn  11046:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  11047:             if ($numremref) {
                   11048:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   11049:             }
                   11050:             if ($numinvalid) {
                   11051:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   11052:             }
                   11053:             if ($numexisting) {
                   11054:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   11055:             }
                   11056:             $output .= '</ul><br />';
                   11057:         } elsif ($numremref) {
                   11058:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   11059:         } elsif ($numinvalid) {
                   11060:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   11061:         } elsif ($numexisting) {
                   11062:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   11063:         }
                   11064:         $output .= $upload_output.'<br />';
                   11065:     }
                   11066:     my ($pathchange_output,$chgcount);
1.1071    raeburn  11067:     $chgcount = $counter;
1.987     raeburn  11068:     if (keys(%pathchanges) > 0) {
                   11069:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  11070:             if ($counter) {
1.987     raeburn  11071:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   11072:                                                   $embed_file,\%mapping,
1.1071    raeburn  11073:                                                   $allfiles,$codebase,'change');
1.987     raeburn  11074:             } else {
                   11075:                 $pathchange_output .= 
                   11076:                     &start_data_table_row().
                   11077:                     '<td><input type ="checkbox" name="namechange" value="'.
                   11078:                     $chgcount.'" checked="checked" /></td>'.
                   11079:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   11080:                     '<td>'.$embed_file.
                   11081:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  11082:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  11083:                     '</td>'.&end_data_table_row();
1.660     raeburn  11084:             }
1.987     raeburn  11085:             $numpathchg ++;
                   11086:             $chgcount ++;
1.660     raeburn  11087:         }
                   11088:     }
1.1127    raeburn  11089:     if (($counter) || ($numunused)) {
1.987     raeburn  11090:         if ($numpathchg) {
                   11091:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   11092:                        $numpathchg.'" />'."\n";
                   11093:         }
                   11094:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   11095:             ($actionurl eq '/adm/imsimport')) {
                   11096:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   11097:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   11098:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  11099:         } elsif ($actionurl eq '/adm/dependencies') {
                   11100:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  11101:         }
1.1123    raeburn  11102:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  11103:     } elsif ($numpathchg) {
                   11104:         my %pathchange = ();
                   11105:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   11106:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11107:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  11108:         }
1.987     raeburn  11109:     }
1.1071    raeburn  11110:     return ($output,$counter,$numpathchg);
1.987     raeburn  11111: }
                   11112: 
1.1147    raeburn  11113: =pod
                   11114: 
                   11115: =item * clean_path($name)
                   11116: 
                   11117: Performs clean-up of directories, subdirectories and filename in an
                   11118: embedded object, referenced in an HTML file which is being uploaded
                   11119: to a course or portfolio, where 
                   11120: "Upload embedded images/multimedia files if HTML file" checkbox was
                   11121: checked.
                   11122: 
                   11123: Clean-up is similar to replacements in lonnet::clean_filename()
                   11124: except each / between sub-directory and next level is preserved.
                   11125: 
                   11126: =cut
                   11127: 
                   11128: sub clean_path {
                   11129:     my ($embed_file) = @_;
                   11130:     $embed_file =~s{^/+}{};
                   11131:     my @contents;
                   11132:     if ($embed_file =~ m{/}) {
                   11133:         @contents = split(/\//,$embed_file);
                   11134:     } else {
                   11135:         @contents = ($embed_file);
                   11136:     }
                   11137:     my $lastidx = scalar(@contents)-1;
                   11138:     for (my $i=0; $i<=$lastidx; $i++) { 
                   11139:         $contents[$i]=~s{\\}{/}g;
                   11140:         $contents[$i]=~s/\s+/\_/g;
                   11141:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   11142:         if ($i == $lastidx) {
                   11143:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   11144:         }
                   11145:     }
                   11146:     if ($lastidx > 0) {
                   11147:         return join('/',@contents);
                   11148:     } else {
                   11149:         return $contents[0];
                   11150:     }
                   11151: }
                   11152: 
1.987     raeburn  11153: sub embedded_file_element {
1.1071    raeburn  11154:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  11155:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   11156:                    (ref($codebase) eq 'HASH'));
                   11157:     my $output;
1.1071    raeburn  11158:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  11159:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   11160:     }
                   11161:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   11162:                &escape($embed_file).'" />';
                   11163:     unless (($context eq 'upload_embedded') && 
                   11164:             ($mapping->{$embed_file} eq $embed_file)) {
                   11165:         $output .='
                   11166:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   11167:     }
                   11168:     my $attrib;
                   11169:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   11170:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   11171:     }
                   11172:     $output .=
                   11173:         "\n\t\t".
                   11174:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   11175:         $attrib.'" />';
                   11176:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   11177:         $output .=
                   11178:             "\n\t\t".
                   11179:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   11180:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  11181:     }
1.987     raeburn  11182:     return $output;
1.660     raeburn  11183: }
                   11184: 
1.1071    raeburn  11185: sub get_dependency_details {
                   11186:     my ($currfile,$currsubfile,$embed_file) = @_;
                   11187:     my ($size,$mtime,$showsize,$showmtime);
                   11188:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   11189:         if ($embed_file =~ m{/}) {
                   11190:             my ($path,$fname) = split(/\//,$embed_file);
                   11191:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   11192:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   11193:             }
                   11194:         } else {
                   11195:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   11196:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   11197:             }
                   11198:         }
                   11199:         $showsize = $size/1024.0;
                   11200:         $showsize = sprintf("%.1f",$showsize);
                   11201:         if ($mtime > 0) {
                   11202:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   11203:         }
                   11204:     }
                   11205:     return ($showsize,$showmtime);
                   11206: }
                   11207: 
                   11208: sub ask_embedded_js {
                   11209:     return <<"END";
                   11210: <script type="text/javascript"">
                   11211: // <![CDATA[
                   11212: function toggleBrowse(counter) {
                   11213:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   11214:     var fileid = document.getElementById('embedded_item_'+counter);
                   11215:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   11216:     if (chkboxid.checked == true) {
                   11217:         uploaddivid.style.display='block';
                   11218:     } else {
                   11219:         uploaddivid.style.display='none';
                   11220:         fileid.value = '';
                   11221:     }
                   11222: }
                   11223: // ]]>
                   11224: </script>
                   11225: 
                   11226: END
                   11227: }
                   11228: 
1.661     raeburn  11229: sub upload_embedded {
                   11230:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  11231:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   11232:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  11233:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   11234:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   11235:         my $orig_uploaded_filename =
                   11236:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  11237:         foreach my $type ('orig','ref','attrib','codebase') {
                   11238:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   11239:                 $env{'form.embedded_'.$type.'_'.$i} =
                   11240:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   11241:             }
                   11242:         }
1.661     raeburn  11243:         my ($path,$fname) =
                   11244:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   11245:         # no path, whole string is fname
                   11246:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   11247:         $fname = &Apache::lonnet::clean_filename($fname);
                   11248:         # See if there is anything left
                   11249:         next if ($fname eq '');
                   11250: 
                   11251:         # Check if file already exists as a file or directory.
                   11252:         my ($state,$msg);
                   11253:         if ($context eq 'portfolio') {
                   11254:             my $port_path = $dirpath;
                   11255:             if ($group ne '') {
                   11256:                 $port_path = "groups/$group/$port_path";
                   11257:             }
1.987     raeburn  11258:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   11259:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  11260:                                               $dir_root,$port_path,$disk_quota,
                   11261:                                               $current_disk_usage,$uname,$udom);
                   11262:             if ($state eq 'will_exceed_quota'
1.984     raeburn  11263:                 || $state eq 'file_locked') {
1.661     raeburn  11264:                 $output .= $msg;
                   11265:                 next;
                   11266:             }
                   11267:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   11268:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   11269:             if ($state eq 'exists') {
                   11270:                 $output .= $msg;
                   11271:                 next;
                   11272:             }
                   11273:         }
                   11274:         # Check if extension is valid
                   11275:         if (($fname =~ /\.(\w+)$/) &&
                   11276:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   11277:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   11278:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  11279:             next;
                   11280:         } elsif (($fname =~ /\.(\w+)$/) &&
                   11281:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  11282:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  11283:             next;
                   11284:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   11285:             $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  11286:             next;
                   11287:         }
                   11288:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  11289:         my $subdir = $path;
                   11290:         $subdir =~ s{/+$}{};
1.661     raeburn  11291:         if ($context eq 'portfolio') {
1.984     raeburn  11292:             my $result;
                   11293:             if ($state eq 'existingfile') {
                   11294:                 $result=
                   11295:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  11296:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  11297:             } else {
1.984     raeburn  11298:                 $result=
                   11299:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  11300:                                                     $dirpath.
1.1123    raeburn  11301:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  11302:                 if ($result !~ m|^/uploaded/|) {
                   11303:                     $output .= '<span class="LC_error">'
                   11304:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11305:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11306:                                .'</span><br />';
                   11307:                     next;
                   11308:                 } else {
1.987     raeburn  11309:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11310:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  11311:                 }
1.661     raeburn  11312:             }
1.1123    raeburn  11313:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  11314:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   11315:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  11316:             my $result =
1.1126    raeburn  11317:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  11318:             if ($result !~ m|^/uploaded/|) {
                   11319:                 $output .= '<span class="LC_error">'
                   11320:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11321:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11322:                            .'</span><br />';
                   11323:                     next;
                   11324:             } else {
                   11325:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11326:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  11327:                 if ($context eq 'syllabus') {
                   11328:                     &Apache::lonnet::make_public_indefinitely($result);
                   11329:                 }
1.987     raeburn  11330:             }
1.661     raeburn  11331:         } else {
                   11332: # Save the file
                   11333:             my $target = $env{'form.embedded_item_'.$i};
                   11334:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   11335:             my $dest = $fullpath.$fname;
                   11336:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  11337:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  11338:             my $count;
                   11339:             my $filepath = $dir_root;
1.1027    raeburn  11340:             foreach my $subdir (@parts) {
                   11341:                 $filepath .= "/$subdir";
                   11342:                 if (!-e $filepath) {
1.661     raeburn  11343:                     mkdir($filepath,0770);
                   11344:                 }
                   11345:             }
                   11346:             my $fh;
                   11347:             if (!open($fh,'>'.$dest)) {
                   11348:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   11349:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  11350:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   11351:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11352:                            '</span><br />';
                   11353:             } else {
                   11354:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   11355:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   11356:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  11357:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   11358:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11359:                               '</span><br />';
                   11360:                 } else {
1.987     raeburn  11361:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11362:                                $url.'</span>').'<br />';
                   11363:                     unless ($context eq 'testbank') {
                   11364:                         $footer .= &mt('View embedded file: [_1]',
                   11365:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   11366:                     }
                   11367:                 }
                   11368:                 close($fh);
                   11369:             }
                   11370:         }
                   11371:         if ($env{'form.embedded_ref_'.$i}) {
                   11372:             $pathchange{$i} = 1;
                   11373:         }
                   11374:     }
                   11375:     if ($output) {
                   11376:         $output = '<p>'.$output.'</p>';
                   11377:     }
                   11378:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   11379:     $returnflag = 'ok';
1.1071    raeburn  11380:     my $numpathchgs = scalar(keys(%pathchange));
                   11381:     if ($numpathchgs > 0) {
1.987     raeburn  11382:         if ($context eq 'portfolio') {
                   11383:             $output .= '<p>'.&mt('or').'</p>';
                   11384:         } elsif ($context eq 'testbank') {
1.1071    raeburn  11385:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   11386:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  11387:             $returnflag = 'modify_orightml';
                   11388:         }
                   11389:     }
1.1071    raeburn  11390:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  11391: }
                   11392: 
                   11393: sub modify_html_form {
                   11394:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   11395:     my $end = 0;
                   11396:     my $modifyform;
                   11397:     if ($context eq 'upload_embedded') {
                   11398:         return unless (ref($pathchange) eq 'HASH');
                   11399:         if ($env{'form.number_embedded_items'}) {
                   11400:             $end += $env{'form.number_embedded_items'};
                   11401:         }
                   11402:         if ($env{'form.number_pathchange_items'}) {
                   11403:             $end += $env{'form.number_pathchange_items'};
                   11404:         }
                   11405:         if ($end) {
                   11406:             for (my $i=0; $i<$end; $i++) {
                   11407:                 if ($i < $env{'form.number_embedded_items'}) {
                   11408:                     next unless($pathchange->{$i});
                   11409:                 }
                   11410:                 $modifyform .=
                   11411:                     &start_data_table_row().
                   11412:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   11413:                     'checked="checked" /></td>'.
                   11414:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   11415:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   11416:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   11417:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   11418:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   11419:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   11420:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   11421:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   11422:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   11423:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   11424:                     &end_data_table_row();
1.1071    raeburn  11425:             }
1.987     raeburn  11426:         }
                   11427:     } else {
                   11428:         $modifyform = $pathchgtable;
                   11429:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   11430:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   11431:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11432:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   11433:         }
                   11434:     }
                   11435:     if ($modifyform) {
1.1071    raeburn  11436:         if ($actionurl eq '/adm/dependencies') {
                   11437:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   11438:         }
1.987     raeburn  11439:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   11440:                '<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".
                   11441:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   11442:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   11443:                '</ol></p>'."\n".'<p>'.
                   11444:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   11445:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   11446:                &start_data_table()."\n".
                   11447:                &start_data_table_header_row().
                   11448:                '<th>'.&mt('Change?').'</th>'.
                   11449:                '<th>'.&mt('Current reference').'</th>'.
                   11450:                '<th>'.&mt('Required reference').'</th>'.
                   11451:                &end_data_table_header_row()."\n".
                   11452:                $modifyform.
                   11453:                &end_data_table().'<br />'."\n".$hiddenstate.
                   11454:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   11455:                '</form>'."\n";
                   11456:     }
                   11457:     return;
                   11458: }
                   11459: 
                   11460: sub modify_html_refs {
1.1123    raeburn  11461:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  11462:     my $container;
                   11463:     if ($context eq 'portfolio') {
                   11464:         $container = $env{'form.container'};
                   11465:     } elsif ($context eq 'coursedoc') {
                   11466:         $container = $env{'form.primaryurl'};
1.1071    raeburn  11467:     } elsif ($context eq 'manage_dependencies') {
                   11468:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   11469:         $container = "/$container";
1.1123    raeburn  11470:     } elsif ($context eq 'syllabus') {
                   11471:         $container = $url;
1.987     raeburn  11472:     } else {
1.1027    raeburn  11473:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  11474:     }
                   11475:     my (%allfiles,%codebase,$output,$content);
                   11476:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  11477:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  11478:         if (wantarray) {
                   11479:             return ('',0,0); 
                   11480:         } else {
                   11481:             return;
                   11482:         }
                   11483:     }
                   11484:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11485:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  11486:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   11487:             if (wantarray) {
                   11488:                 return ('',0,0);
                   11489:             } else {
                   11490:                 return;
                   11491:             }
                   11492:         } 
1.987     raeburn  11493:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  11494:         if ($content eq '-1') {
                   11495:             if (wantarray) {
                   11496:                 return ('',0,0);
                   11497:             } else {
                   11498:                 return;
                   11499:             }
                   11500:         }
1.987     raeburn  11501:     } else {
1.1071    raeburn  11502:         unless ($container =~ /^\Q$dir_root\E/) {
                   11503:             if (wantarray) {
                   11504:                 return ('',0,0);
                   11505:             } else {
                   11506:                 return;
                   11507:             }
                   11508:         } 
1.987     raeburn  11509:         if (open(my $fh,"<$container")) {
                   11510:             $content = join('', <$fh>);
                   11511:             close($fh);
                   11512:         } else {
1.1071    raeburn  11513:             if (wantarray) {
                   11514:                 return ('',0,0);
                   11515:             } else {
                   11516:                 return;
                   11517:             }
1.987     raeburn  11518:         }
                   11519:     }
                   11520:     my ($count,$codebasecount) = (0,0);
                   11521:     my $mm = new File::MMagic;
                   11522:     my $mime_type = $mm->checktype_contents($content);
                   11523:     if ($mime_type eq 'text/html') {
                   11524:         my $parse_result = 
                   11525:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   11526:                                                     \%codebase,\$content);
                   11527:         if ($parse_result eq 'ok') {
                   11528:             foreach my $i (@changes) {
                   11529:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   11530:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   11531:                 if ($allfiles{$ref}) {
                   11532:                     my $newname =  $orig;
                   11533:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  11534:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  11535:                     if ($attrib_regexp =~ /:/) {
                   11536:                         $attrib_regexp =~ s/\:/|/g;
                   11537:                     }
                   11538:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11539:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11540:                         $count += $numchg;
1.1123    raeburn  11541:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  11542:                         delete($allfiles{$ref});
1.987     raeburn  11543:                     }
                   11544:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  11545:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  11546:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   11547:                         $codebasecount ++;
                   11548:                     }
                   11549:                 }
                   11550:             }
1.1123    raeburn  11551:             my $skiprewrites;
1.987     raeburn  11552:             if ($count || $codebasecount) {
                   11553:                 my $saveresult;
1.1071    raeburn  11554:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11555:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  11556:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11557:                     if ($url eq $container) {
                   11558:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   11559:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11560:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  11561:                                             $fname.'</span>').'</p>';
1.987     raeburn  11562:                     } else {
                   11563:                          $output = '<p class="LC_error">'.
                   11564:                                    &mt('Error: update failed for: [_1].',
                   11565:                                    '<span class="LC_filename">'.
                   11566:                                    $container.'</span>').'</p>';
                   11567:                     }
1.1123    raeburn  11568:                     if ($context eq 'syllabus') {
                   11569:                         unless ($saveresult eq 'ok') {
                   11570:                             $skiprewrites = 1;
                   11571:                         }
                   11572:                     }
1.987     raeburn  11573:                 } else {
                   11574:                     if (open(my $fh,">$container")) {
                   11575:                         print $fh $content;
                   11576:                         close($fh);
                   11577:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11578:                                   $count,'<span class="LC_filename">'.
                   11579:                                   $container.'</span>').'</p>';
1.661     raeburn  11580:                     } else {
1.987     raeburn  11581:                          $output = '<p class="LC_error">'.
                   11582:                                    &mt('Error: could not update [_1].',
                   11583:                                    '<span class="LC_filename">'.
                   11584:                                    $container.'</span>').'</p>';
1.661     raeburn  11585:                     }
                   11586:                 }
                   11587:             }
1.1123    raeburn  11588:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   11589:                 my ($actionurl,$state);
                   11590:                 $actionurl = "/public/$udom/$uname/syllabus";
                   11591:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   11592:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   11593:                                               \%codebase,
                   11594:                                               {'context' => 'rewrites',
                   11595:                                                'ignore_remote_references' => 1,});
                   11596:                 if (ref($mapping) eq 'HASH') {
                   11597:                     my $rewrites = 0;
                   11598:                     foreach my $key (keys(%{$mapping})) {
                   11599:                         next if ($key =~ m{^https?://});
                   11600:                         my $ref = $mapping->{$key};
                   11601:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   11602:                         my $attrib;
                   11603:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   11604:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   11605:                         }
                   11606:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11607:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11608:                             $rewrites += $numchg;
                   11609:                         }
                   11610:                     }
                   11611:                     if ($rewrites) {
                   11612:                         my $saveresult; 
                   11613:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11614:                         if ($url eq $container) {
                   11615:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   11616:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   11617:                                             $count,'<span class="LC_filename">'.
                   11618:                                             $fname.'</span>').'</p>';
                   11619:                         } else {
                   11620:                             $output .= '<p class="LC_error">'.
                   11621:                                        &mt('Error: could not update links in [_1].',
                   11622:                                        '<span class="LC_filename">'.
                   11623:                                        $container.'</span>').'</p>';
                   11624: 
                   11625:                         }
                   11626:                     }
                   11627:                 }
                   11628:             }
1.987     raeburn  11629:         } else {
                   11630:             &logthis('Failed to parse '.$container.
                   11631:                      ' to modify references: '.$parse_result);
1.661     raeburn  11632:         }
                   11633:     }
1.1071    raeburn  11634:     if (wantarray) {
                   11635:         return ($output,$count,$codebasecount);
                   11636:     } else {
                   11637:         return $output;
                   11638:     }
1.661     raeburn  11639: }
                   11640: 
                   11641: sub check_for_existing {
                   11642:     my ($path,$fname,$element) = @_;
                   11643:     my ($state,$msg);
                   11644:     if (-d $path.'/'.$fname) {
                   11645:         $state = 'exists';
                   11646:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11647:     } elsif (-e $path.'/'.$fname) {
                   11648:         $state = 'exists';
                   11649:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11650:     }
                   11651:     if ($state eq 'exists') {
                   11652:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   11653:     }
                   11654:     return ($state,$msg);
                   11655: }
                   11656: 
                   11657: sub check_for_upload {
                   11658:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   11659:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  11660:     my $filesize = length($env{'form.'.$element});
                   11661:     if (!$filesize) {
                   11662:         my $msg = '<span class="LC_error">'.
                   11663:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   11664:                       '<span class="LC_filename">'.$fname.'</span>',
                   11665:                       $filesize).'<br />'.
1.1007    raeburn  11666:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  11667:                   '</span>';
                   11668:         return ('zero_bytes',$msg);
                   11669:     }
                   11670:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  11671:     my $getpropath = 1;
1.1021    raeburn  11672:     my ($dirlistref,$listerror) =
                   11673:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  11674:     my $found_file = 0;
                   11675:     my $locked_file = 0;
1.991     raeburn  11676:     my @lockers;
                   11677:     my $navmap;
                   11678:     if ($env{'request.course.id'}) {
                   11679:         $navmap = Apache::lonnavmaps::navmap->new();
                   11680:     }
1.1021    raeburn  11681:     if (ref($dirlistref) eq 'ARRAY') {
                   11682:         foreach my $line (@{$dirlistref}) {
                   11683:             my ($file_name,$rest)=split(/\&/,$line,2);
                   11684:             if ($file_name eq $fname){
                   11685:                 $file_name = $path.$file_name;
                   11686:                 if ($group ne '') {
                   11687:                     $file_name = $group.$file_name;
                   11688:                 }
                   11689:                 $found_file = 1;
                   11690:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   11691:                     foreach my $lock (@lockers) {
                   11692:                         if (ref($lock) eq 'ARRAY') {
                   11693:                             my ($symb,$crsid) = @{$lock};
                   11694:                             if ($crsid eq $env{'request.course.id'}) {
                   11695:                                 if (ref($navmap)) {
                   11696:                                     my $res = $navmap->getBySymb($symb);
                   11697:                                     foreach my $part (@{$res->parts()}) { 
                   11698:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   11699:                                         unless (($slot_status == $res->RESERVED) ||
                   11700:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   11701:                                             $locked_file = 1;
                   11702:                                         }
1.991     raeburn  11703:                                     }
1.1021    raeburn  11704:                                 } else {
                   11705:                                     $locked_file = 1;
1.991     raeburn  11706:                                 }
                   11707:                             } else {
                   11708:                                 $locked_file = 1;
                   11709:                             }
                   11710:                         }
1.1021    raeburn  11711:                    }
                   11712:                 } else {
                   11713:                     my @info = split(/\&/,$rest);
                   11714:                     my $currsize = $info[6]/1000;
                   11715:                     if ($currsize < $filesize) {
                   11716:                         my $extra = $filesize - $currsize;
                   11717:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   11718:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  11719:                                       &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   11720:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   11721:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   11722:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  11723:                             return ('will_exceed_quota',$msg);
                   11724:                         }
1.984     raeburn  11725:                     }
                   11726:                 }
1.661     raeburn  11727:             }
                   11728:         }
                   11729:     }
                   11730:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   11731:         my $msg = '<p class="LC_warning">'.
                   11732:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184    raeburn  11733:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  11734:         return ('will_exceed_quota',$msg);
                   11735:     } elsif ($found_file) {
                   11736:         if ($locked_file) {
1.1179    bisitz   11737:             my $msg = '<p class="LC_warning">';
1.661     raeburn  11738:             $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   11739:             $msg .= '</p>';
1.661     raeburn  11740:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   11741:             return ('file_locked',$msg);
                   11742:         } else {
1.1179    bisitz   11743:             my $msg = '<p class="LC_error">';
1.984     raeburn  11744:             $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   11745:             $msg .= '</p>';
1.984     raeburn  11746:             return ('existingfile',$msg);
1.661     raeburn  11747:         }
                   11748:     }
                   11749: }
                   11750: 
1.987     raeburn  11751: sub check_for_traversal {
                   11752:     my ($path,$url,$toplevel) = @_;
                   11753:     my @parts=split(/\//,$path);
                   11754:     my $cleanpath;
                   11755:     my $fullpath = $url;
                   11756:     for (my $i=0;$i<@parts;$i++) {
                   11757:         next if ($parts[$i] eq '.');
                   11758:         if ($parts[$i] eq '..') {
                   11759:             $fullpath =~ s{([^/]+/)$}{};
                   11760:         } else {
                   11761:             $fullpath .= $parts[$i].'/';
                   11762:         }
                   11763:     }
                   11764:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   11765:         $cleanpath = $1;
                   11766:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11767:         my $curr_toprel = $1;
                   11768:         my @parts = split(/\//,$curr_toprel);
                   11769:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11770:         my @urlparts = split(/\//,$url_toprel);
                   11771:         my $doubledots;
                   11772:         my $startdiff = -1;
                   11773:         for (my $i=0; $i<@urlparts; $i++) {
                   11774:             if ($startdiff == -1) {
                   11775:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11776:                     $startdiff = $i;
                   11777:                     $doubledots .= '../';
                   11778:                 }
                   11779:             } else {
                   11780:                 $doubledots .= '../';
                   11781:             }
                   11782:         }
                   11783:         if ($startdiff > -1) {
                   11784:             $cleanpath = $doubledots;
                   11785:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11786:                 $cleanpath .= $parts[$i].'/';
                   11787:             }
                   11788:         }
                   11789:     }
                   11790:     $cleanpath =~ s{(/)$}{};
                   11791:     return $cleanpath;
                   11792: }
1.31      albertel 11793: 
1.1053    raeburn  11794: sub is_archive_file {
                   11795:     my ($mimetype) = @_;
                   11796:     if (($mimetype eq 'application/octet-stream') ||
                   11797:         ($mimetype eq 'application/x-stuffit') ||
                   11798:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11799:         return 1;
                   11800:     }
                   11801:     return;
                   11802: }
                   11803: 
                   11804: sub decompress_form {
1.1065    raeburn  11805:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11806:     my %lt = &Apache::lonlocal::texthash (
                   11807:         this => 'This file is an archive file.',
1.1067    raeburn  11808:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11809:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11810:         youm => 'You may wish to extract its contents.',
                   11811:         extr => 'Extract contents',
1.1067    raeburn  11812:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11813:         proa => 'Process automatically?',
1.1053    raeburn  11814:         yes  => 'Yes',
                   11815:         no   => 'No',
1.1067    raeburn  11816:         fold => 'Title for folder containing movie',
                   11817:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11818:     );
1.1065    raeburn  11819:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11820:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11821:     my $info = &list_archive_contents($fileloc,\@paths);
                   11822:     if (@paths) {
                   11823:         foreach my $path (@paths) {
                   11824:             $path =~ s{^/}{};
1.1067    raeburn  11825:             if ($path =~ m{^([^/]+)/$}) {
                   11826:                 $topdir = $1;
                   11827:             }
1.1065    raeburn  11828:             if ($path =~ m{^([^/]+)/}) {
                   11829:                 $toplevel{$1} = $path;
                   11830:             } else {
                   11831:                 $toplevel{$path} = $path;
                   11832:             }
                   11833:         }
                   11834:     }
1.1067    raeburn  11835:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  11836:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11837:                         "$topdir/media/",
                   11838:                         "$topdir/media/$topdir.mp4",
                   11839:                         "$topdir/media/FirstFrame.png",
                   11840:                         "$topdir/media/player.swf",
                   11841:                         "$topdir/media/swfobject.js",
                   11842:                         "$topdir/media/expressInstall.swf");
1.1197    raeburn  11843:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164    raeburn  11844:                          "$topdir/$topdir.mp4",
                   11845:                          "$topdir/$topdir\_config.xml",
                   11846:                          "$topdir/$topdir\_controller.swf",
                   11847:                          "$topdir/$topdir\_embed.css",
                   11848:                          "$topdir/$topdir\_First_Frame.png",
                   11849:                          "$topdir/$topdir\_player.html",
                   11850:                          "$topdir/$topdir\_Thumbnails.png",
                   11851:                          "$topdir/playerProductInstall.swf",
                   11852:                          "$topdir/scripts/",
                   11853:                          "$topdir/scripts/config_xml.js",
                   11854:                          "$topdir/scripts/handlebars.js",
                   11855:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11856:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11857:                          "$topdir/scripts/modernizr.js",
                   11858:                          "$topdir/scripts/player-min.js",
                   11859:                          "$topdir/scripts/swfobject.js",
                   11860:                          "$topdir/skins/",
                   11861:                          "$topdir/skins/configuration_express.xml",
                   11862:                          "$topdir/skins/express_show/",
                   11863:                          "$topdir/skins/express_show/player-min.css",
                   11864:                          "$topdir/skins/express_show/spritesheet.png");
1.1197    raeburn  11865:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11866:                          "$topdir/$topdir.mp4",
                   11867:                          "$topdir/$topdir\_config.xml",
                   11868:                          "$topdir/$topdir\_controller.swf",
                   11869:                          "$topdir/$topdir\_embed.css",
                   11870:                          "$topdir/$topdir\_First_Frame.png",
                   11871:                          "$topdir/$topdir\_player.html",
                   11872:                          "$topdir/$topdir\_Thumbnails.png",
                   11873:                          "$topdir/playerProductInstall.swf",
                   11874:                          "$topdir/scripts/",
                   11875:                          "$topdir/scripts/config_xml.js",
                   11876:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11877:                          "$topdir/skins/",
                   11878:                          "$topdir/skins/configuration_express.xml",
                   11879:                          "$topdir/skins/express_show/",
                   11880:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11881:                          "$topdir/skins/express_show/spritesheet.png",
                   11882:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164    raeburn  11883:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11884:         if (@diffs == 0) {
1.1164    raeburn  11885:             $is_camtasia = 6;
                   11886:         } else {
1.1197    raeburn  11887:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164    raeburn  11888:             if (@diffs == 0) {
                   11889:                 $is_camtasia = 8;
1.1197    raeburn  11890:             } else {
                   11891:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11892:                 if (@diffs == 0) {
                   11893:                     $is_camtasia = 8;
                   11894:                 }
1.1164    raeburn  11895:             }
1.1067    raeburn  11896:         }
                   11897:     }
                   11898:     my $output;
                   11899:     if ($is_camtasia) {
                   11900:         $output = <<"ENDCAM";
                   11901: <script type="text/javascript" language="Javascript">
                   11902: // <![CDATA[
                   11903: 
                   11904: function camtasiaToggle() {
                   11905:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11906:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  11907:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11908:                 document.getElementById('camtasia_titles').style.display='block';
                   11909:             } else {
                   11910:                 document.getElementById('camtasia_titles').style.display='none';
                   11911:             }
                   11912:         }
                   11913:     }
                   11914:     return;
                   11915: }
                   11916: 
                   11917: // ]]>
                   11918: </script>
                   11919: <p>$lt{'camt'}</p>
                   11920: ENDCAM
1.1065    raeburn  11921:     } else {
1.1067    raeburn  11922:         $output = '<p>'.$lt{'this'};
                   11923:         if ($info eq '') {
                   11924:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11925:         } else {
                   11926:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11927:                        '<div><pre>'.$info.'</pre></div>';
                   11928:         }
1.1065    raeburn  11929:     }
1.1067    raeburn  11930:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11931:     my $duplicates;
                   11932:     my $num = 0;
                   11933:     if (ref($dirlist) eq 'ARRAY') {
                   11934:         foreach my $item (@{$dirlist}) {
                   11935:             if (ref($item) eq 'ARRAY') {
                   11936:                 if (exists($toplevel{$item->[0]})) {
                   11937:                     $duplicates .= 
                   11938:                         &start_data_table_row().
                   11939:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11940:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11941:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11942:                         'value="1" />'.&mt('Yes').'</label>'.
                   11943:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11944:                         '<td>'.$item->[0].'</td>';
                   11945:                     if ($item->[2]) {
                   11946:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11947:                     } else {
                   11948:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11949:                     }
                   11950:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11951:                                    '<td>'.
                   11952:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11953:                                    '</td>'.
                   11954:                                    &end_data_table_row();
                   11955:                     $num ++;
                   11956:                 }
                   11957:             }
                   11958:         }
                   11959:     }
                   11960:     my $itemcount;
                   11961:     if (@paths > 0) {
                   11962:         $itemcount = scalar(@paths);
                   11963:     } else {
                   11964:         $itemcount = 1;
                   11965:     }
1.1067    raeburn  11966:     if ($is_camtasia) {
                   11967:         $output .= $lt{'auto'}.'<br />'.
                   11968:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  11969:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11970:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11971:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11972:                    $lt{'no'}.'</label></span><br />'.
                   11973:                    '<div id="camtasia_titles" style="display:block">'.
                   11974:                    &Apache::lonhtmlcommon::start_pick_box().
                   11975:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11976:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11977:                    &Apache::lonhtmlcommon::row_closure().
                   11978:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11979:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11980:                    &Apache::lonhtmlcommon::row_closure(1).
                   11981:                    &Apache::lonhtmlcommon::end_pick_box().
                   11982:                    '</div>';
                   11983:     }
1.1065    raeburn  11984:     $output .= 
                   11985:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11986:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11987:         "\n";
1.1065    raeburn  11988:     if ($duplicates ne '') {
                   11989:         $output .= '<p><span class="LC_warning">'.
                   11990:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11991:                    &start_data_table().
                   11992:                    &start_data_table_header_row().
                   11993:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11994:                    '<th>'.&mt('Name').'</th>'.
                   11995:                    '<th>'.&mt('Type').'</th>'.
                   11996:                    '<th>'.&mt('Size').'</th>'.
                   11997:                    '<th>'.&mt('Last modified').'</th>'.
                   11998:                    &end_data_table_header_row().
                   11999:                    $duplicates.
                   12000:                    &end_data_table().
                   12001:                    '</p>';
                   12002:     }
1.1067    raeburn  12003:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  12004:     if (ref($hiddenelements) eq 'HASH') {
                   12005:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   12006:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   12007:         }
                   12008:     }
                   12009:     $output .= <<"END";
1.1067    raeburn  12010: <br />
1.1053    raeburn  12011: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   12012: </form>
                   12013: $noextract
                   12014: END
                   12015:     return $output;
                   12016: }
                   12017: 
1.1065    raeburn  12018: sub decompression_utility {
                   12019:     my ($program) = @_;
                   12020:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   12021:     my $location;
                   12022:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   12023:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   12024:                          '/usr/sbin/') {
                   12025:             if (-x $dir.$program) {
                   12026:                 $location = $dir.$program;
                   12027:                 last;
                   12028:             }
                   12029:         }
                   12030:     }
                   12031:     return $location;
                   12032: }
                   12033: 
                   12034: sub list_archive_contents {
                   12035:     my ($file,$pathsref) = @_;
                   12036:     my (@cmd,$output);
                   12037:     my $needsregexp;
                   12038:     if ($file =~ /\.zip$/) {
                   12039:         @cmd = (&decompression_utility('unzip'),"-l");
                   12040:         $needsregexp = 1;
                   12041:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   12042:              ($file =~ /\.tgz$/)) {
                   12043:         @cmd = (&decompression_utility('tar'),"-ztf");
                   12044:     } elsif ($file =~ /\.tar\.bz2$/) {
                   12045:         @cmd = (&decompression_utility('tar'),"-jtf");
                   12046:     } elsif ($file =~ m|\.tar$|) {
                   12047:         @cmd = (&decompression_utility('tar'),"-tf");
                   12048:     }
                   12049:     if (@cmd) {
                   12050:         undef($!);
                   12051:         undef($@);
                   12052:         if (open(my $fh,"-|", @cmd, $file)) {
                   12053:             while (my $line = <$fh>) {
                   12054:                 $output .= $line;
                   12055:                 chomp($line);
                   12056:                 my $item;
                   12057:                 if ($needsregexp) {
                   12058:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   12059:                 } else {
                   12060:                     $item = $line;
                   12061:                 }
                   12062:                 if ($item ne '') {
                   12063:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   12064:                         push(@{$pathsref},$item);
                   12065:                     } 
                   12066:                 }
                   12067:             }
                   12068:             close($fh);
                   12069:         }
                   12070:     }
                   12071:     return $output;
                   12072: }
                   12073: 
1.1053    raeburn  12074: sub decompress_uploaded_file {
                   12075:     my ($file,$dir) = @_;
                   12076:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   12077:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   12078:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   12079:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   12080:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   12081:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   12082:     my $decompressed = $env{'cgi.decompressed'};
                   12083:     &Apache::lonnet::delenv('cgi.file');
                   12084:     &Apache::lonnet::delenv('cgi.dir');
                   12085:     &Apache::lonnet::delenv('cgi.decompressed');
                   12086:     return ($decompressed,$result);
                   12087: }
                   12088: 
1.1055    raeburn  12089: sub process_decompression {
                   12090:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   12091:     my ($dir,$error,$warning,$output);
1.1180    raeburn  12092:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   12093:         $error = &mt('Filename not a supported archive file type.').
                   12094:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  12095:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   12096:     } else {
                   12097:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12098:         if ($docuhome eq 'no_host') {
                   12099:             $error = &mt('Could not determine home server for course.');
                   12100:         } else {
                   12101:             my @ids=&Apache::lonnet::current_machine_ids();
                   12102:             my $currdir = "$dir_root/$destination";
                   12103:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12104:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   12105:                        "$dir_root/$destination";
                   12106:             } else {
                   12107:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   12108:                        "$dir_root/$docudom/$docuname/$destination";
                   12109:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   12110:                     $error = &mt('Archive file not found.');
                   12111:                 }
                   12112:             }
1.1065    raeburn  12113:             my (@to_overwrite,@to_skip);
                   12114:             if ($env{'form.archive_overwrite_total'} > 0) {
                   12115:                 my $total = $env{'form.archive_overwrite_total'};
                   12116:                 for (my $i=0; $i<$total; $i++) {
                   12117:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   12118:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   12119:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   12120:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   12121:                     }
                   12122:                 }
                   12123:             }
                   12124:             my $numskip = scalar(@to_skip);
                   12125:             if (($numskip > 0) && 
                   12126:                 ($numskip == $env{'form.archive_itemcount'})) {
                   12127:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   12128:             } elsif ($dir eq '') {
1.1055    raeburn  12129:                 $error = &mt('Directory containing archive file unavailable.');
                   12130:             } elsif (!$error) {
1.1065    raeburn  12131:                 my ($decompressed,$display);
                   12132:                 if ($numskip > 0) {
                   12133:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   12134:                     mkdir("$dir/$tempdir",0755);
                   12135:                     system("mv $dir/$file $dir/$tempdir/$file");
                   12136:                     ($decompressed,$display) = 
                   12137:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   12138:                     foreach my $item (@to_skip) {
                   12139:                         if (($item ne '') && ($item !~ /\.\./)) {
                   12140:                             if (-f "$dir/$tempdir/$item") { 
                   12141:                                 unlink("$dir/$tempdir/$item");
                   12142:                             } elsif (-d "$dir/$tempdir/$item") {
                   12143:                                 system("rm -rf $dir/$tempdir/$item");
                   12144:                             }
                   12145:                         }
                   12146:                     }
                   12147:                     system("mv $dir/$tempdir/* $dir");
                   12148:                     rmdir("$dir/$tempdir");   
                   12149:                 } else {
                   12150:                     ($decompressed,$display) = 
                   12151:                         &decompress_uploaded_file($file,$dir);
                   12152:                 }
1.1055    raeburn  12153:                 if ($decompressed eq 'ok') {
1.1065    raeburn  12154:                     $output = '<p class="LC_info">'.
                   12155:                               &mt('Files extracted successfully from archive.').
                   12156:                               '</p>'."\n";
1.1055    raeburn  12157:                     my ($warning,$result,@contents);
                   12158:                     my ($newdirlistref,$newlisterror) =
                   12159:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   12160:                                                  $docuname,1);
                   12161:                     my (%is_dir,%changes,@newitems);
                   12162:                     my $dirptr = 16384;
1.1065    raeburn  12163:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  12164:                         foreach my $dir_line (@{$newdirlistref}) {
                   12165:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  12166:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   12167:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  12168:                                 push(@newitems,$item);
                   12169:                                 if ($dirptr&$testdir) {
                   12170:                                     $is_dir{$item} = 1;
                   12171:                                 }
                   12172:                                 $changes{$item} = 1;
                   12173:                             }
                   12174:                         }
                   12175:                     }
                   12176:                     if (keys(%changes) > 0) {
                   12177:                         foreach my $item (sort(@newitems)) {
                   12178:                             if ($changes{$item}) {
                   12179:                                 push(@contents,$item);
                   12180:                             }
                   12181:                         }
                   12182:                     }
                   12183:                     if (@contents > 0) {
1.1067    raeburn  12184:                         my $wantform;
                   12185:                         unless ($env{'form.autoextract_camtasia'}) {
                   12186:                             $wantform = 1;
                   12187:                         }
1.1056    raeburn  12188:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  12189:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   12190:                                                                 $currdir,\%is_dir,
                   12191:                                                                 \%children,\%parent,
1.1056    raeburn  12192:                                                                 \@contents,\%dirorder,
                   12193:                                                                 \%titles,$wantform);
1.1055    raeburn  12194:                         if ($datatable ne '') {
                   12195:                             $output .= &archive_options_form('decompressed',$datatable,
                   12196:                                                              $count,$hiddenelem);
1.1065    raeburn  12197:                             my $startcount = 6;
1.1055    raeburn  12198:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  12199:                                                            \%titles,\%children);
1.1055    raeburn  12200:                         }
1.1067    raeburn  12201:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  12202:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  12203:                             my %displayed;
                   12204:                             my $total = 1;
                   12205:                             $env{'form.archive_directory'} = [];
                   12206:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   12207:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   12208:                                 $path =~ s{/$}{};
                   12209:                                 my $item;
                   12210:                                 if ($path ne '') {
                   12211:                                     $item = "$path/$titles{$i}";
                   12212:                                 } else {
                   12213:                                     $item = $titles{$i};
                   12214:                                 }
                   12215:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   12216:                                 if ($item eq $contents[0]) {
                   12217:                                     push(@{$env{'form.archive_directory'}},$i);
                   12218:                                     $env{'form.archive_'.$i} = 'display';
                   12219:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   12220:                                     $displayed{'folder'} = $i;
1.1164    raeburn  12221:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   12222:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  12223:                                     $env{'form.archive_'.$i} = 'display';
                   12224:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   12225:                                     $displayed{'web'} = $i;
                   12226:                                 } else {
1.1164    raeburn  12227:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   12228:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   12229:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  12230:                                         push(@{$env{'form.archive_directory'}},$i);
                   12231:                                     }
                   12232:                                     $env{'form.archive_'.$i} = 'dependency';
                   12233:                                 }
                   12234:                                 $total ++;
                   12235:                             }
                   12236:                             for (my $i=1; $i<$total; $i++) {
                   12237:                                 next if ($i == $displayed{'web'});
                   12238:                                 next if ($i == $displayed{'folder'});
                   12239:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   12240:                             }
                   12241:                             $env{'form.phase'} = 'decompress_cleanup';
                   12242:                             $env{'form.archivedelete'} = 1;
                   12243:                             $env{'form.archive_count'} = $total-1;
                   12244:                             $output .=
                   12245:                                 &process_extracted_files('coursedocs',$docudom,
                   12246:                                                          $docuname,$destination,
                   12247:                                                          $dir_root,$hiddenelem);
                   12248:                         }
1.1055    raeburn  12249:                     } else {
                   12250:                         $warning = &mt('No new items extracted from archive file.');
                   12251:                     }
                   12252:                 } else {
                   12253:                     $output = $display;
                   12254:                     $error = &mt('An error occurred during extraction from the archive file.');
                   12255:                 }
                   12256:             }
                   12257:         }
                   12258:     }
                   12259:     if ($error) {
                   12260:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12261:                    $error.'</p>'."\n";
                   12262:     }
                   12263:     if ($warning) {
                   12264:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12265:     }
                   12266:     return $output;
                   12267: }
                   12268: 
                   12269: sub get_extracted {
1.1056    raeburn  12270:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   12271:         $titles,$wantform) = @_;
1.1055    raeburn  12272:     my $count = 0;
                   12273:     my $depth = 0;
                   12274:     my $datatable;
1.1056    raeburn  12275:     my @hierarchy;
1.1055    raeburn  12276:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  12277:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   12278:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  12279:     foreach my $item (@{$contents}) {
                   12280:         $count ++;
1.1056    raeburn  12281:         @{$dirorder->{$count}} = @hierarchy;
                   12282:         $titles->{$count} = $item;
1.1055    raeburn  12283:         &archive_hierarchy($depth,$count,$parent,$children);
                   12284:         if ($wantform) {
                   12285:             $datatable .= &archive_row($is_dir->{$item},$item,
                   12286:                                        $currdir,$depth,$count);
                   12287:         }
                   12288:         if ($is_dir->{$item}) {
                   12289:             $depth ++;
1.1056    raeburn  12290:             push(@hierarchy,$count);
                   12291:             $parent->{$depth} = $count;
1.1055    raeburn  12292:             $datatable .=
                   12293:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  12294:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   12295:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  12296:             $depth --;
1.1056    raeburn  12297:             pop(@hierarchy);
1.1055    raeburn  12298:         }
                   12299:     }
                   12300:     return ($count,$datatable);
                   12301: }
                   12302: 
                   12303: sub recurse_extracted_archive {
1.1056    raeburn  12304:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   12305:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  12306:     my $result='';
1.1056    raeburn  12307:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   12308:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   12309:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  12310:         return $result;
                   12311:     }
                   12312:     my $dirptr = 16384;
                   12313:     my ($newdirlistref,$newlisterror) =
                   12314:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   12315:     if (ref($newdirlistref) eq 'ARRAY') {
                   12316:         foreach my $dir_line (@{$newdirlistref}) {
                   12317:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   12318:             unless ($item =~ /^\.+$/) {
                   12319:                 $$count ++;
1.1056    raeburn  12320:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   12321:                 $titles->{$$count} = $item;
1.1055    raeburn  12322:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  12323: 
1.1055    raeburn  12324:                 my $is_dir;
                   12325:                 if ($dirptr&$testdir) {
                   12326:                     $is_dir = 1;
                   12327:                 }
                   12328:                 if ($wantform) {
                   12329:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   12330:                 }
                   12331:                 if ($is_dir) {
                   12332:                     $$depth ++;
1.1056    raeburn  12333:                     push(@{$hierarchy},$$count);
                   12334:                     $parent->{$$depth} = $$count;
1.1055    raeburn  12335:                     $result .=
                   12336:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   12337:                                                    $docuname,$depth,$count,
1.1056    raeburn  12338:                                                    $hierarchy,$dirorder,$children,
                   12339:                                                    $parent,$titles,$wantform);
1.1055    raeburn  12340:                     $$depth --;
1.1056    raeburn  12341:                     pop(@{$hierarchy});
1.1055    raeburn  12342:                 }
                   12343:             }
                   12344:         }
                   12345:     }
                   12346:     return $result;
                   12347: }
                   12348: 
                   12349: sub archive_hierarchy {
                   12350:     my ($depth,$count,$parent,$children) =@_;
                   12351:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   12352:         if (exists($parent->{$depth})) {
                   12353:              $children->{$parent->{$depth}} .= $count.':';
                   12354:         }
                   12355:     }
                   12356:     return;
                   12357: }
                   12358: 
                   12359: sub archive_row {
                   12360:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   12361:     my ($name) = ($item =~ m{([^/]+)$});
                   12362:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  12363:                                        'display'    => 'Add as file',
1.1055    raeburn  12364:                                        'dependency' => 'Include as dependency',
                   12365:                                        'discard'    => 'Discard',
                   12366:                                       );
                   12367:     if ($is_dir) {
1.1059    raeburn  12368:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  12369:     }
1.1056    raeburn  12370:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   12371:     my $offset = 0;
1.1055    raeburn  12372:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  12373:         $offset ++;
1.1065    raeburn  12374:         if ($action ne 'display') {
                   12375:             $offset ++;
                   12376:         }  
1.1055    raeburn  12377:         $output .= '<td><span class="LC_nobreak">'.
                   12378:                    '<label><input type="radio" name="archive_'.$count.
                   12379:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   12380:         my $text = $choices{$action};
                   12381:         if ($is_dir) {
                   12382:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   12383:             if ($action eq 'display') {
1.1059    raeburn  12384:                 $text = &mt('Add as folder');
1.1055    raeburn  12385:             }
1.1056    raeburn  12386:         } else {
                   12387:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   12388: 
                   12389:         }
                   12390:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   12391:         if ($action eq 'dependency') {
                   12392:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   12393:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   12394:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   12395:                        '<option value=""></option>'."\n".
                   12396:                        '</select>'."\n".
                   12397:                        '</div>';
1.1059    raeburn  12398:         } elsif ($action eq 'display') {
                   12399:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   12400:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   12401:                        '</div>';
1.1055    raeburn  12402:         }
1.1056    raeburn  12403:         $output .= '</td>';
1.1055    raeburn  12404:     }
                   12405:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   12406:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   12407:     for (my $i=0; $i<$depth; $i++) {
                   12408:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   12409:     }
                   12410:     if ($is_dir) {
                   12411:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   12412:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   12413:     } else {
                   12414:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   12415:     }
                   12416:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   12417:                &end_data_table_row();
                   12418:     return $output;
                   12419: }
                   12420: 
                   12421: sub archive_options_form {
1.1065    raeburn  12422:     my ($form,$display,$count,$hiddenelem) = @_;
                   12423:     my %lt = &Apache::lonlocal::texthash(
                   12424:                perm => 'Permanently remove archive file?',
                   12425:                hows => 'How should each extracted item be incorporated in the course?',
                   12426:                cont => 'Content actions for all',
                   12427:                addf => 'Add as folder/file',
                   12428:                incd => 'Include as dependency for a displayed file',
                   12429:                disc => 'Discard',
                   12430:                no   => 'No',
                   12431:                yes  => 'Yes',
                   12432:                save => 'Save',
                   12433:     );
                   12434:     my $output = <<"END";
                   12435: <form name="$form" method="post" action="">
                   12436: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   12437: <label>
                   12438:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   12439: </label>
                   12440: &nbsp;
                   12441: <label>
                   12442:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   12443: </span>
                   12444: </p>
                   12445: <input type="hidden" name="phase" value="decompress_cleanup" />
                   12446: <br />$lt{'hows'}
                   12447: <div class="LC_columnSection">
                   12448:   <fieldset>
                   12449:     <legend>$lt{'cont'}</legend>
                   12450:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   12451:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   12452:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   12453:   </fieldset>
                   12454: </div>
                   12455: END
                   12456:     return $output.
1.1055    raeburn  12457:            &start_data_table()."\n".
1.1065    raeburn  12458:            $display."\n".
1.1055    raeburn  12459:            &end_data_table()."\n".
                   12460:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   12461:            $hiddenelem.
1.1065    raeburn  12462:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  12463:            '</form>';
                   12464: }
                   12465: 
                   12466: sub archive_javascript {
1.1056    raeburn  12467:     my ($startcount,$numitems,$titles,$children) = @_;
                   12468:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  12469:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  12470:     my $scripttag = <<START;
                   12471: <script type="text/javascript">
                   12472: // <![CDATA[
                   12473: 
                   12474: function checkAll(form,prefix) {
                   12475:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   12476:     for (var i=0; i < form.elements.length; i++) {
                   12477:         var id = form.elements[i].id;
                   12478:         if ((id != '') && (id != undefined)) {
                   12479:             if (idstr.test(id)) {
                   12480:                 if (form.elements[i].type == 'radio') {
                   12481:                     form.elements[i].checked = true;
1.1056    raeburn  12482:                     var nostart = i-$startcount;
1.1059    raeburn  12483:                     var offset = nostart%7;
                   12484:                     var count = (nostart-offset)/7;    
1.1056    raeburn  12485:                     dependencyCheck(form,count,offset);
1.1055    raeburn  12486:                 }
                   12487:             }
                   12488:         }
                   12489:     }
                   12490: }
                   12491: 
                   12492: function propagateCheck(form,count) {
                   12493:     if (count > 0) {
1.1059    raeburn  12494:         var startelement = $startcount + ((count-1) * 7);
                   12495:         for (var j=1; j<6; j++) {
                   12496:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  12497:                 var item = startelement + j; 
                   12498:                 if (form.elements[item].type == 'radio') {
                   12499:                     if (form.elements[item].checked) {
                   12500:                         containerCheck(form,count,j);
                   12501:                         break;
                   12502:                     }
1.1055    raeburn  12503:                 }
                   12504:             }
                   12505:         }
                   12506:     }
                   12507: }
                   12508: 
                   12509: numitems = $numitems
1.1056    raeburn  12510: var titles = new Array(numitems);
                   12511: var parents = new Array(numitems);
1.1055    raeburn  12512: for (var i=0; i<numitems; i++) {
1.1056    raeburn  12513:     parents[i] = new Array;
1.1055    raeburn  12514: }
1.1059    raeburn  12515: var maintitle = '$maintitle';
1.1055    raeburn  12516: 
                   12517: START
                   12518: 
1.1056    raeburn  12519:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   12520:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  12521:         for (my $i=0; $i<@contents; $i ++) {
                   12522:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   12523:         }
                   12524:     }
                   12525: 
1.1056    raeburn  12526:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   12527:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   12528:     }
                   12529: 
1.1055    raeburn  12530:     $scripttag .= <<END;
                   12531: 
                   12532: function containerCheck(form,count,offset) {
                   12533:     if (count > 0) {
1.1056    raeburn  12534:         dependencyCheck(form,count,offset);
1.1059    raeburn  12535:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  12536:         form.elements[item].checked = true;
                   12537:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12538:             if (parents[count].length > 0) {
                   12539:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  12540:                     containerCheck(form,parents[count][j],offset);
                   12541:                 }
                   12542:             }
                   12543:         }
                   12544:     }
                   12545: }
                   12546: 
                   12547: function dependencyCheck(form,count,offset) {
                   12548:     if (count > 0) {
1.1059    raeburn  12549:         var chosen = (offset+$startcount)+7*(count-1);
                   12550:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  12551:         var currtype = form.elements[depitem].type;
                   12552:         if (form.elements[chosen].value == 'dependency') {
                   12553:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   12554:             form.elements[depitem].options.length = 0;
                   12555:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  12556:             for (var i=1; i<=numitems; i++) {
                   12557:                 if (i == count) {
                   12558:                     continue;
                   12559:                 }
1.1059    raeburn  12560:                 var startelement = $startcount + (i-1) * 7;
                   12561:                 for (var j=1; j<6; j++) {
                   12562:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  12563:                         var item = startelement + j;
                   12564:                         if (form.elements[item].type == 'radio') {
                   12565:                             if (form.elements[item].checked) {
                   12566:                                 if (form.elements[item].value == 'display') {
                   12567:                                     var n = form.elements[depitem].options.length;
                   12568:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   12569:                                 }
                   12570:                             }
                   12571:                         }
                   12572:                     }
                   12573:                 }
                   12574:             }
                   12575:         } else {
                   12576:             document.getElementById('arc_depon_'+count).style.display='none';
                   12577:             form.elements[depitem].options.length = 0;
                   12578:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   12579:         }
1.1059    raeburn  12580:         titleCheck(form,count,offset);
1.1056    raeburn  12581:     }
                   12582: }
                   12583: 
                   12584: function propagateSelect(form,count,offset) {
                   12585:     if (count > 0) {
1.1065    raeburn  12586:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  12587:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   12588:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12589:             if (parents[count].length > 0) {
                   12590:                 for (var j=0; j<parents[count].length; j++) {
                   12591:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  12592:                 }
                   12593:             }
                   12594:         }
                   12595:     }
                   12596: }
1.1056    raeburn  12597: 
                   12598: function containerSelect(form,count,offset,picked) {
                   12599:     if (count > 0) {
1.1065    raeburn  12600:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  12601:         if (form.elements[item].type == 'radio') {
                   12602:             if (form.elements[item].value == 'dependency') {
                   12603:                 if (form.elements[item+1].type == 'select-one') {
                   12604:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   12605:                         if (form.elements[item+1].options[i].value == picked) {
                   12606:                             form.elements[item+1].selectedIndex = i;
                   12607:                             break;
                   12608:                         }
                   12609:                     }
                   12610:                 }
                   12611:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12612:                     if (parents[count].length > 0) {
                   12613:                         for (var j=0; j<parents[count].length; j++) {
                   12614:                             containerSelect(form,parents[count][j],offset,picked);
                   12615:                         }
                   12616:                     }
                   12617:                 }
                   12618:             }
                   12619:         }
                   12620:     }
                   12621: }
                   12622: 
1.1059    raeburn  12623: function titleCheck(form,count,offset) {
                   12624:     if (count > 0) {
                   12625:         var chosen = (offset+$startcount)+7*(count-1);
                   12626:         var depitem = $startcount + ((count-1) * 7) + 2;
                   12627:         var currtype = form.elements[depitem].type;
                   12628:         if (form.elements[chosen].value == 'display') {
                   12629:             document.getElementById('arc_title_'+count).style.display='block';
                   12630:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   12631:                 document.getElementById('archive_title_'+count).value=maintitle;
                   12632:             }
                   12633:         } else {
                   12634:             document.getElementById('arc_title_'+count).style.display='none';
                   12635:             if (currtype == 'text') { 
                   12636:                 document.getElementById('archive_title_'+count).value='';
                   12637:             }
                   12638:         }
                   12639:     }
                   12640:     return;
                   12641: }
                   12642: 
1.1055    raeburn  12643: // ]]>
                   12644: </script>
                   12645: END
                   12646:     return $scripttag;
                   12647: }
                   12648: 
                   12649: sub process_extracted_files {
1.1067    raeburn  12650:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  12651:     my $numitems = $env{'form.archive_count'};
                   12652:     return unless ($numitems);
                   12653:     my @ids=&Apache::lonnet::current_machine_ids();
                   12654:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  12655:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  12656:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12657:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12658:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   12659:         $pathtocheck = "$dir_root/$destination";
                   12660:         $dir = $dir_root;
                   12661:         $ishome = 1;
                   12662:     } else {
                   12663:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   12664:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   12665:         $dir = "$dir_root/$docudom/$docuname";    
                   12666:     }
                   12667:     my $currdir = "$dir_root/$destination";
                   12668:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   12669:     if ($env{'form.folderpath'}) {
                   12670:         my @items = split('&',$env{'form.folderpath'});
                   12671:         $folders{'0'} = $items[-2];
1.1099    raeburn  12672:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   12673:             $containers{'0'}='page';
                   12674:         } else {  
                   12675:             $containers{'0'}='sequence';
                   12676:         }
1.1055    raeburn  12677:     }
                   12678:     my @archdirs = &get_env_multiple('form.archive_directory');
                   12679:     if ($numitems) {
                   12680:         for (my $i=1; $i<=$numitems; $i++) {
                   12681:             my $path = $env{'form.archive_content_'.$i};
                   12682:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   12683:                 my $item = $1;
                   12684:                 $toplevelitems{$item} = $i;
                   12685:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   12686:                     $is_dir{$item} = 1;
                   12687:                 }
                   12688:             }
                   12689:         }
                   12690:     }
1.1067    raeburn  12691:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  12692:     if (keys(%toplevelitems) > 0) {
                   12693:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  12694:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   12695:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  12696:     }
1.1066    raeburn  12697:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  12698:     if ($numitems) {
                   12699:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  12700:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  12701:             my $path = $env{'form.archive_content_'.$i};
                   12702:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12703:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   12704:                     if ($prefix ne '' && $path ne '') {
                   12705:                         if (-e $prefix.$path) {
1.1066    raeburn  12706:                             if ((@archdirs > 0) && 
                   12707:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   12708:                                 $todeletedir{$prefix.$path} = 1;
                   12709:                             } else {
                   12710:                                 $todelete{$prefix.$path} = 1;
                   12711:                             }
1.1055    raeburn  12712:                         }
                   12713:                     }
                   12714:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  12715:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  12716:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  12717:                     $docstitle = $env{'form.archive_title_'.$i};
                   12718:                     if ($docstitle eq '') {
                   12719:                         $docstitle = $title;
                   12720:                     }
1.1055    raeburn  12721:                     $outer = 0;
1.1056    raeburn  12722:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12723:                         if (@{$dirorder{$i}} > 0) {
                   12724:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  12725:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   12726:                                     $outer = $item;
                   12727:                                     last;
                   12728:                                 }
                   12729:                             }
                   12730:                         }
                   12731:                     }
                   12732:                     my ($errtext,$fatal) = 
                   12733:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   12734:                                                '/'.$folders{$outer}.'.'.
                   12735:                                                $containers{$outer});
                   12736:                     next if ($fatal);
                   12737:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   12738:                         if ($context eq 'coursedocs') {
1.1056    raeburn  12739:                             $mapinner{$i} = time;
1.1055    raeburn  12740:                             $folders{$i} = 'default_'.$mapinner{$i};
                   12741:                             $containers{$i} = 'sequence';
                   12742:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12743:                                       $folders{$i}.'.'.$containers{$i};
                   12744:                             my $newidx = &LONCAPA::map::getresidx();
                   12745:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12746:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12747:                             push(@LONCAPA::map::order,$newidx);
                   12748:                             my ($outtext,$errtext) =
                   12749:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12750:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12751:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  12752:                             $newseqid{$i} = $newidx;
1.1067    raeburn  12753:                             unless ($errtext) {
                   12754:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   12755:                             }
1.1055    raeburn  12756:                         }
                   12757:                     } else {
                   12758:                         if ($context eq 'coursedocs') {
                   12759:                             my $newidx=&LONCAPA::map::getresidx();
                   12760:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12761:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   12762:                                       $title;
                   12763:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   12764:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   12765:                             }
                   12766:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12767:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12768:                             }
                   12769:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12770:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  12771:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  12772:                                 unless ($ishome) {
                   12773:                                     my $fetch = "$newdest{$i}/$title";
                   12774:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12775:                                     $prompttofetch{$fetch} = 1;
                   12776:                                 }
1.1055    raeburn  12777:                             }
                   12778:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12779:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12780:                             push(@LONCAPA::map::order, $newidx);
                   12781:                             my ($outtext,$errtext)=
                   12782:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12783:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12784:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  12785:                             unless ($errtext) {
                   12786:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12787:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   12788:                                 }
                   12789:                             }
1.1055    raeburn  12790:                         }
                   12791:                     }
1.1086    raeburn  12792:                 }
                   12793:             } else {
                   12794:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12795:             }
                   12796:         }
                   12797:         for (my $i=1; $i<=$numitems; $i++) {
                   12798:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12799:             my $path = $env{'form.archive_content_'.$i};
                   12800:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12801:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12802:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12803:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12804:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12805:                         my ($itemidx,$fullpath,$relpath);
                   12806:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12807:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12808:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  12809:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12810:                                     $itemidx = $j;
1.1056    raeburn  12811:                                 }
                   12812:                             }
1.1086    raeburn  12813:                         }
                   12814:                         if ($itemidx eq '') {
                   12815:                             $itemidx =  0;
                   12816:                         } 
                   12817:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12818:                             if ($mapinner{$referrer{$i}}) {
                   12819:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12820:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12821:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12822:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12823:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12824:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12825:                                             if (!-e $fullpath) {
                   12826:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12827:                                             }
                   12828:                                         }
1.1086    raeburn  12829:                                     } else {
                   12830:                                         last;
1.1056    raeburn  12831:                                     }
1.1086    raeburn  12832:                                 }
                   12833:                             }
                   12834:                         } elsif ($newdest{$referrer{$i}}) {
                   12835:                             $fullpath = $newdest{$referrer{$i}};
                   12836:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12837:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12838:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12839:                                     last;
                   12840:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12841:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12842:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12843:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12844:                                         if (!-e $fullpath) {
                   12845:                                             mkdir($fullpath,0755);
1.1056    raeburn  12846:                                         }
                   12847:                                     }
1.1086    raeburn  12848:                                 } else {
                   12849:                                     last;
1.1056    raeburn  12850:                                 }
1.1055    raeburn  12851:                             }
                   12852:                         }
1.1086    raeburn  12853:                         if ($fullpath ne '') {
                   12854:                             if (-e "$prefix$path") {
                   12855:                                 system("mv $prefix$path $fullpath/$title");
                   12856:                             }
                   12857:                             if (-e "$fullpath/$title") {
                   12858:                                 my $showpath;
                   12859:                                 if ($relpath ne '') {
                   12860:                                     $showpath = "$relpath/$title";
                   12861:                                 } else {
                   12862:                                     $showpath = "/$title";
                   12863:                                 } 
                   12864:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12865:                             } 
                   12866:                             unless ($ishome) {
                   12867:                                 my $fetch = "$fullpath/$title";
                   12868:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   12869:                                 $prompttofetch{$fetch} = 1;
                   12870:                             }
                   12871:                         }
1.1055    raeburn  12872:                     }
1.1086    raeburn  12873:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12874:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12875:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12876:                 }
                   12877:             } else {
                   12878:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12879:             }
                   12880:         }
                   12881:         if (keys(%todelete)) {
                   12882:             foreach my $key (keys(%todelete)) {
                   12883:                 unlink($key);
1.1066    raeburn  12884:             }
                   12885:         }
                   12886:         if (keys(%todeletedir)) {
                   12887:             foreach my $key (keys(%todeletedir)) {
                   12888:                 rmdir($key);
                   12889:             }
                   12890:         }
                   12891:         foreach my $dir (sort(keys(%is_dir))) {
                   12892:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12893:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12894:             }
                   12895:         }
1.1067    raeburn  12896:         if ($result ne '') {
                   12897:             $output .= '<ul>'."\n".
                   12898:                        $result."\n".
                   12899:                        '</ul>';
                   12900:         }
                   12901:         unless ($ishome) {
                   12902:             my $replicationfail;
                   12903:             foreach my $item (keys(%prompttofetch)) {
                   12904:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12905:                 unless ($fetchresult eq 'ok') {
                   12906:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12907:                 }
                   12908:             }
                   12909:             if ($replicationfail) {
                   12910:                 $output .= '<p class="LC_error">'.
                   12911:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12912:                            $replicationfail.
                   12913:                            '</ul></p>';
                   12914:             }
                   12915:         }
1.1055    raeburn  12916:     } else {
                   12917:         $warning = &mt('No items found in archive.');
                   12918:     }
                   12919:     if ($error) {
                   12920:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12921:                    $error.'</p>'."\n";
                   12922:     }
                   12923:     if ($warning) {
                   12924:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12925:     }
                   12926:     return $output;
                   12927: }
                   12928: 
1.1066    raeburn  12929: sub cleanup_empty_dirs {
                   12930:     my ($path) = @_;
                   12931:     if (($path ne '') && (-d $path)) {
                   12932:         if (opendir(my $dirh,$path)) {
                   12933:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12934:             my $numitems = 0;
                   12935:             foreach my $item (@dircontents) {
                   12936:                 if (-d "$path/$item") {
1.1111    raeburn  12937:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12938:                     if (-e "$path/$item") {
                   12939:                         $numitems ++;
                   12940:                     }
                   12941:                 } else {
                   12942:                     $numitems ++;
                   12943:                 }
                   12944:             }
                   12945:             if ($numitems == 0) {
                   12946:                 rmdir($path);
                   12947:             }
                   12948:             closedir($dirh);
                   12949:         }
                   12950:     }
                   12951:     return;
                   12952: }
                   12953: 
1.41      ng       12954: =pod
1.45      matthew  12955: 
1.1162    raeburn  12956: =item * &get_folder_hierarchy()
1.1068    raeburn  12957: 
                   12958: Provides hierarchy of names of folders/sub-folders containing the current
                   12959: item,
                   12960: 
                   12961: Inputs: 3
                   12962:      - $navmap - navmaps object
                   12963: 
                   12964:      - $map - url for map (either the trigger itself, or map containing
                   12965:                            the resource, which is the trigger).
                   12966: 
                   12967:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12968: 
                   12969: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12970: 
                   12971: =cut
                   12972: 
                   12973: sub get_folder_hierarchy {
                   12974:     my ($navmap,$map,$showitem) = @_;
                   12975:     my @pathitems;
                   12976:     if (ref($navmap)) {
                   12977:         my $mapres = $navmap->getResourceByUrl($map);
                   12978:         if (ref($mapres)) {
                   12979:             my $pcslist = $mapres->map_hierarchy();
                   12980:             if ($pcslist ne '') {
                   12981:                 my @pcs = split(/,/,$pcslist);
                   12982:                 foreach my $pc (@pcs) {
                   12983:                     if ($pc == 1) {
1.1129    raeburn  12984:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12985:                     } else {
                   12986:                         my $res = $navmap->getByMapPc($pc);
                   12987:                         if (ref($res)) {
                   12988:                             my $title = $res->compTitle();
                   12989:                             $title =~ s/\W+/_/g;
                   12990:                             if ($title ne '') {
                   12991:                                 push(@pathitems,$title);
                   12992:                             }
                   12993:                         }
                   12994:                     }
                   12995:                 }
                   12996:             }
1.1071    raeburn  12997:             if ($showitem) {
                   12998:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12999:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  13000:                 } else {
                   13001:                     my $maptitle = $mapres->compTitle();
                   13002:                     $maptitle =~ s/\W+/_/g;
                   13003:                     if ($maptitle ne '') {
                   13004:                         push(@pathitems,$maptitle);
                   13005:                     }
1.1068    raeburn  13006:                 }
                   13007:             }
                   13008:         }
                   13009:     }
                   13010:     return @pathitems;
                   13011: }
                   13012: 
                   13013: =pod
                   13014: 
1.1015    raeburn  13015: =item * &get_turnedin_filepath()
                   13016: 
                   13017: Determines path in a user's portfolio file for storage of files uploaded
                   13018: to a specific essayresponse or dropbox item.
                   13019: 
                   13020: Inputs: 3 required + 1 optional.
                   13021: $symb is symb for resource, $uname and $udom are for current user (required).
                   13022: $caller is optional (can be "submission", if routine is called when storing
                   13023: an upoaded file when "Submit Answer" button was pressed).
                   13024: 
                   13025: Returns array containing $path and $multiresp. 
                   13026: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   13027: than one file upload item.  Callers of routine should append partid as a 
                   13028: subdirectory to $path in cases where $multiresp is 1.
                   13029: 
                   13030: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   13031: 
                   13032: =cut
                   13033: 
                   13034: sub get_turnedin_filepath {
                   13035:     my ($symb,$uname,$udom,$caller) = @_;
                   13036:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   13037:     my $turnindir;
                   13038:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   13039:     $turnindir = $userhash{'turnindir'};
                   13040:     my ($path,$multiresp);
                   13041:     if ($turnindir eq '') {
                   13042:         if ($caller eq 'submission') {
                   13043:             $turnindir = &mt('turned in');
                   13044:             $turnindir =~ s/\W+/_/g;
                   13045:             my %newhash = (
                   13046:                             'turnindir' => $turnindir,
                   13047:                           );
                   13048:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   13049:         }
                   13050:     }
                   13051:     if ($turnindir ne '') {
                   13052:         $path = '/'.$turnindir.'/';
                   13053:         my ($multipart,$turnin,@pathitems);
                   13054:         my $navmap = Apache::lonnavmaps::navmap->new();
                   13055:         if (defined($navmap)) {
                   13056:             my $mapres = $navmap->getResourceByUrl($map);
                   13057:             if (ref($mapres)) {
                   13058:                 my $pcslist = $mapres->map_hierarchy();
                   13059:                 if ($pcslist ne '') {
                   13060:                     foreach my $pc (split(/,/,$pcslist)) {
                   13061:                         my $res = $navmap->getByMapPc($pc);
                   13062:                         if (ref($res)) {
                   13063:                             my $title = $res->compTitle();
                   13064:                             $title =~ s/\W+/_/g;
                   13065:                             if ($title ne '') {
1.1149    raeburn  13066:                                 if (($pc > 1) && (length($title) > 12)) {
                   13067:                                     $title = substr($title,0,12);
                   13068:                                 }
1.1015    raeburn  13069:                                 push(@pathitems,$title);
                   13070:                             }
                   13071:                         }
                   13072:                     }
                   13073:                 }
                   13074:                 my $maptitle = $mapres->compTitle();
                   13075:                 $maptitle =~ s/\W+/_/g;
                   13076:                 if ($maptitle ne '') {
1.1149    raeburn  13077:                     if (length($maptitle) > 12) {
                   13078:                         $maptitle = substr($maptitle,0,12);
                   13079:                     }
1.1015    raeburn  13080:                     push(@pathitems,$maptitle);
                   13081:                 }
                   13082:                 unless ($env{'request.state'} eq 'construct') {
                   13083:                     my $res = $navmap->getBySymb($symb);
                   13084:                     if (ref($res)) {
                   13085:                         my $partlist = $res->parts();
                   13086:                         my $totaluploads = 0;
                   13087:                         if (ref($partlist) eq 'ARRAY') {
                   13088:                             foreach my $part (@{$partlist}) {
                   13089:                                 my @types = $res->responseType($part);
                   13090:                                 my @ids = $res->responseIds($part);
                   13091:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   13092:                                     if ($types[$i] eq 'essay') {
                   13093:                                         my $partid = $part.'_'.$ids[$i];
                   13094:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   13095:                                             $totaluploads ++;
                   13096:                                         }
                   13097:                                     }
                   13098:                                 }
                   13099:                             }
                   13100:                             if ($totaluploads > 1) {
                   13101:                                 $multiresp = 1;
                   13102:                             }
                   13103:                         }
                   13104:                     }
                   13105:                 }
                   13106:             } else {
                   13107:                 return;
                   13108:             }
                   13109:         } else {
                   13110:             return;
                   13111:         }
                   13112:         my $restitle=&Apache::lonnet::gettitle($symb);
                   13113:         $restitle =~ s/\W+/_/g;
                   13114:         if ($restitle eq '') {
                   13115:             $restitle = ($resurl =~ m{/[^/]+$});
                   13116:             if ($restitle eq '') {
                   13117:                 $restitle = time;
                   13118:             }
                   13119:         }
1.1149    raeburn  13120:         if (length($restitle) > 12) {
                   13121:             $restitle = substr($restitle,0,12);
                   13122:         }
1.1015    raeburn  13123:         push(@pathitems,$restitle);
                   13124:         $path .= join('/',@pathitems);
                   13125:     }
                   13126:     return ($path,$multiresp);
                   13127: }
                   13128: 
                   13129: =pod
                   13130: 
1.464     albertel 13131: =back
1.41      ng       13132: 
1.112     bowersj2 13133: =head1 CSV Upload/Handling functions
1.38      albertel 13134: 
1.41      ng       13135: =over 4
                   13136: 
1.648     raeburn  13137: =item * &upfile_store($r)
1.41      ng       13138: 
                   13139: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 13140: needs $env{'form.upfile'}
1.41      ng       13141: returns $datatoken to be put into hidden field
                   13142: 
                   13143: =cut
1.31      albertel 13144: 
                   13145: sub upfile_store {
                   13146:     my $r=shift;
1.258     albertel 13147:     $env{'form.upfile'}=~s/\r/\n/gs;
                   13148:     $env{'form.upfile'}=~s/\f/\n/gs;
                   13149:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   13150:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 13151: 
1.258     albertel 13152:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   13153: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 13154:     {
1.158     raeburn  13155:         my $datafile = $r->dir_config('lonDaemons').
                   13156:                            '/tmp/'.$datatoken.'.tmp';
                   13157:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 13158:             print $fh $env{'form.upfile'};
1.158     raeburn  13159:             close($fh);
                   13160:         }
1.31      albertel 13161:     }
                   13162:     return $datatoken;
                   13163: }
                   13164: 
1.56      matthew  13165: =pod
                   13166: 
1.648     raeburn  13167: =item * &load_tmp_file($r)
1.41      ng       13168: 
                   13169: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 13170: needs $env{'form.datatoken'},
                   13171: sets $env{'form.upfile'} to the contents of the file
1.41      ng       13172: 
                   13173: =cut
1.31      albertel 13174: 
                   13175: sub load_tmp_file {
                   13176:     my $r=shift;
                   13177:     my @studentdata=();
                   13178:     {
1.158     raeburn  13179:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 13180:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  13181:         if ( open(my $fh,"<$studentfile") ) {
                   13182:             @studentdata=<$fh>;
                   13183:             close($fh);
                   13184:         }
1.31      albertel 13185:     }
1.258     albertel 13186:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 13187: }
                   13188: 
1.56      matthew  13189: =pod
                   13190: 
1.648     raeburn  13191: =item * &upfile_record_sep()
1.41      ng       13192: 
                   13193: Separate uploaded file into records
                   13194: returns array of records,
1.258     albertel 13195: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       13196: 
                   13197: =cut
1.31      albertel 13198: 
                   13199: sub upfile_record_sep {
1.258     albertel 13200:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 13201:     } else {
1.248     albertel 13202: 	my @records;
1.258     albertel 13203: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 13204: 	    if ($line=~/^\s*$/) { next; }
                   13205: 	    push(@records,$line);
                   13206: 	}
                   13207: 	return @records;
1.31      albertel 13208:     }
                   13209: }
                   13210: 
1.56      matthew  13211: =pod
                   13212: 
1.648     raeburn  13213: =item * &record_sep($record)
1.41      ng       13214: 
1.258     albertel 13215: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       13216: 
                   13217: =cut
                   13218: 
1.263     www      13219: sub takeleft {
                   13220:     my $index=shift;
                   13221:     return substr('0000'.$index,-4,4);
                   13222: }
                   13223: 
1.31      albertel 13224: sub record_sep {
                   13225:     my $record=shift;
                   13226:     my %components=();
1.258     albertel 13227:     if ($env{'form.upfiletype'} eq 'xml') {
                   13228:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 13229:         my $i=0;
1.356     albertel 13230:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 13231:             $field=~s/^(\"|\')//;
                   13232:             $field=~s/(\"|\')$//;
1.263     www      13233:             $components{&takeleft($i)}=$field;
1.31      albertel 13234:             $i++;
                   13235:         }
1.258     albertel 13236:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 13237:         my $i=0;
1.356     albertel 13238:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 13239:             $field=~s/^(\"|\')//;
                   13240:             $field=~s/(\"|\')$//;
1.263     www      13241:             $components{&takeleft($i)}=$field;
1.31      albertel 13242:             $i++;
                   13243:         }
                   13244:     } else {
1.561     www      13245:         my $separator=',';
1.480     banghart 13246:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      13247:             $separator=';';
1.480     banghart 13248:         }
1.31      albertel 13249:         my $i=0;
1.561     www      13250: # the character we are looking for to indicate the end of a quote or a record 
                   13251:         my $looking_for=$separator;
                   13252: # do not add the characters to the fields
                   13253:         my $ignore=0;
                   13254: # we just encountered a separator (or the beginning of the record)
                   13255:         my $just_found_separator=1;
                   13256: # store the field we are working on here
                   13257:         my $field='';
                   13258: # work our way through all characters in record
                   13259:         foreach my $character ($record=~/(.)/g) {
                   13260:             if ($character eq $looking_for) {
                   13261:                if ($character ne $separator) {
                   13262: # Found the end of a quote, again looking for separator
                   13263:                   $looking_for=$separator;
                   13264:                   $ignore=1;
                   13265:                } else {
                   13266: # Found a separator, store away what we got
                   13267:                   $components{&takeleft($i)}=$field;
                   13268: 	          $i++;
                   13269:                   $just_found_separator=1;
                   13270:                   $ignore=0;
                   13271:                   $field='';
                   13272:                }
                   13273:                next;
                   13274:             }
                   13275: # single or double quotation marks after a separator indicate beginning of a quote
                   13276: # we are now looking for the end of the quote and need to ignore separators
                   13277:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   13278:                $looking_for=$character;
                   13279:                next;
                   13280:             }
                   13281: # ignore would be true after we reached the end of a quote
                   13282:             if ($ignore) { next; }
                   13283:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   13284:             $field.=$character;
                   13285:             $just_found_separator=0; 
1.31      albertel 13286:         }
1.561     www      13287: # catch the very last entry, since we never encountered the separator
                   13288:         $components{&takeleft($i)}=$field;
1.31      albertel 13289:     }
                   13290:     return %components;
                   13291: }
                   13292: 
1.144     matthew  13293: ######################################################
                   13294: ######################################################
                   13295: 
1.56      matthew  13296: =pod
                   13297: 
1.648     raeburn  13298: =item * &upfile_select_html()
1.41      ng       13299: 
1.144     matthew  13300: Return HTML code to select a file from the users machine and specify 
                   13301: the file type.
1.41      ng       13302: 
                   13303: =cut
                   13304: 
1.144     matthew  13305: ######################################################
                   13306: ######################################################
1.31      albertel 13307: sub upfile_select_html {
1.144     matthew  13308:     my %Types = (
                   13309:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 13310:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  13311:                  space => &mt('Space separated'),
                   13312:                  tab   => &mt('Tabulator separated'),
                   13313: #                 xml   => &mt('HTML/XML'),
                   13314:                  );
                   13315:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  13316:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  13317:     foreach my $type (sort(keys(%Types))) {
                   13318:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   13319:     }
                   13320:     $Str .= "</select>\n";
                   13321:     return $Str;
1.31      albertel 13322: }
                   13323: 
1.301     albertel 13324: sub get_samples {
                   13325:     my ($records,$toget) = @_;
                   13326:     my @samples=({});
                   13327:     my $got=0;
                   13328:     foreach my $rec (@$records) {
                   13329: 	my %temp = &record_sep($rec);
                   13330: 	if (! grep(/\S/, values(%temp))) { next; }
                   13331: 	if (%temp) {
                   13332: 	    $samples[$got]=\%temp;
                   13333: 	    $got++;
                   13334: 	    if ($got == $toget) { last; }
                   13335: 	}
                   13336:     }
                   13337:     return \@samples;
                   13338: }
                   13339: 
1.144     matthew  13340: ######################################################
                   13341: ######################################################
                   13342: 
1.56      matthew  13343: =pod
                   13344: 
1.648     raeburn  13345: =item * &csv_print_samples($r,$records)
1.41      ng       13346: 
                   13347: Prints a table of sample values from each column uploaded $r is an
                   13348: Apache Request ref, $records is an arrayref from
                   13349: &Apache::loncommon::upfile_record_sep
                   13350: 
                   13351: =cut
                   13352: 
1.144     matthew  13353: ######################################################
                   13354: ######################################################
1.31      albertel 13355: sub csv_print_samples {
                   13356:     my ($r,$records) = @_;
1.662     bisitz   13357:     my $samples = &get_samples($records,5);
1.301     albertel 13358: 
1.594     raeburn  13359:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   13360:               &start_data_table_header_row());
1.356     albertel 13361:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   13362:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  13363:     $r->print(&end_data_table_header_row());
1.301     albertel 13364:     foreach my $hash (@$samples) {
1.594     raeburn  13365: 	$r->print(&start_data_table_row());
1.356     albertel 13366: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 13367: 	    $r->print('<td>');
1.356     albertel 13368: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 13369: 	    $r->print('</td>');
                   13370: 	}
1.594     raeburn  13371: 	$r->print(&end_data_table_row());
1.31      albertel 13372:     }
1.594     raeburn  13373:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 13374: }
                   13375: 
1.144     matthew  13376: ######################################################
                   13377: ######################################################
                   13378: 
1.56      matthew  13379: =pod
                   13380: 
1.648     raeburn  13381: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       13382: 
                   13383: Prints a table to create associations between values and table columns.
1.144     matthew  13384: 
1.41      ng       13385: $r is an Apache Request ref,
                   13386: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  13387: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       13388: 
                   13389: =cut
                   13390: 
1.144     matthew  13391: ######################################################
                   13392: ######################################################
1.31      albertel 13393: sub csv_print_select_table {
                   13394:     my ($r,$records,$d) = @_;
1.301     albertel 13395:     my $i=0;
                   13396:     my $samples = &get_samples($records,1);
1.144     matthew  13397:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  13398: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  13399:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  13400:               '<th>'.&mt('Column').'</th>'.
                   13401:               &end_data_table_header_row()."\n");
1.356     albertel 13402:     foreach my $array_ref (@$d) {
                   13403: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  13404: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 13405: 
1.875     bisitz   13406: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  13407: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 13408: 	$r->print('<option value="none"></option>');
1.356     albertel 13409: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   13410: 	    $r->print('<option value="'.$sample.'"'.
                   13411:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   13412:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 13413: 	}
1.594     raeburn  13414: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 13415: 	$i++;
                   13416:     }
1.594     raeburn  13417:     $r->print(&end_data_table());
1.31      albertel 13418:     $i--;
                   13419:     return $i;
                   13420: }
1.56      matthew  13421: 
1.144     matthew  13422: ######################################################
                   13423: ######################################################
                   13424: 
1.56      matthew  13425: =pod
1.31      albertel 13426: 
1.648     raeburn  13427: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       13428: 
                   13429: Prints a table of sample values from the upload and can make associate samples to internal names.
                   13430: 
                   13431: $r is an Apache Request ref,
                   13432: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   13433: $d is an array of 2 element arrays (internal name, displayed name)
                   13434: 
                   13435: =cut
                   13436: 
1.144     matthew  13437: ######################################################
                   13438: ######################################################
1.31      albertel 13439: sub csv_samples_select_table {
                   13440:     my ($r,$records,$d) = @_;
                   13441:     my $i=0;
1.144     matthew  13442:     #
1.662     bisitz   13443:     my $max_samples = 5;
                   13444:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  13445:     $r->print(&start_data_table().
                   13446:               &start_data_table_header_row().'<th>'.
                   13447:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   13448:               &end_data_table_header_row());
1.301     albertel 13449: 
                   13450:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  13451: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  13452: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 13453: 	foreach my $option (@$d) {
                   13454: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  13455: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 13456:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  13457:                       $display.'</option>');
1.31      albertel 13458: 	}
                   13459: 	$r->print('</select></td><td>');
1.662     bisitz   13460: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 13461: 	    if (defined($samples->[$line]{$key})) { 
                   13462: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   13463: 	    }
                   13464: 	}
1.594     raeburn  13465: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 13466: 	$i++;
                   13467:     }
1.594     raeburn  13468:     $r->print(&end_data_table());
1.31      albertel 13469:     $i--;
                   13470:     return($i);
1.115     matthew  13471: }
                   13472: 
1.144     matthew  13473: ######################################################
                   13474: ######################################################
                   13475: 
1.115     matthew  13476: =pod
                   13477: 
1.648     raeburn  13478: =item * &clean_excel_name($name)
1.115     matthew  13479: 
                   13480: Returns a replacement for $name which does not contain any illegal characters.
                   13481: 
                   13482: =cut
                   13483: 
1.144     matthew  13484: ######################################################
                   13485: ######################################################
1.115     matthew  13486: sub clean_excel_name {
                   13487:     my ($name) = @_;
                   13488:     $name =~ s/[:\*\?\/\\]//g;
                   13489:     if (length($name) > 31) {
                   13490:         $name = substr($name,0,31);
                   13491:     }
                   13492:     return $name;
1.25      albertel 13493: }
1.84      albertel 13494: 
1.85      albertel 13495: =pod
                   13496: 
1.648     raeburn  13497: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 13498: 
                   13499: Returns either 1 or undef
                   13500: 
                   13501: 1 if the part is to be hidden, undef if it is to be shown
                   13502: 
                   13503: Arguments are:
                   13504: 
                   13505: $id the id of the part to be checked
                   13506: $symb, optional the symb of the resource to check
                   13507: $udom, optional the domain of the user to check for
                   13508: $uname, optional the username of the user to check for
                   13509: 
                   13510: =cut
1.84      albertel 13511: 
                   13512: sub check_if_partid_hidden {
                   13513:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 13514:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 13515: 					 $symb,$udom,$uname);
1.141     albertel 13516:     my $truth=1;
                   13517:     #if the string starts with !, then the list is the list to show not hide
                   13518:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 13519:     my @hiddenlist=split(/,/,$hiddenparts);
                   13520:     foreach my $checkid (@hiddenlist) {
1.141     albertel 13521: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 13522:     }
1.141     albertel 13523:     return !$truth;
1.84      albertel 13524: }
1.127     matthew  13525: 
1.138     matthew  13526: 
                   13527: ############################################################
                   13528: ############################################################
                   13529: 
                   13530: =pod
                   13531: 
1.157     matthew  13532: =back 
                   13533: 
1.138     matthew  13534: =head1 cgi-bin script and graphing routines
                   13535: 
1.157     matthew  13536: =over 4
                   13537: 
1.648     raeburn  13538: =item * &get_cgi_id()
1.138     matthew  13539: 
                   13540: Inputs: none
                   13541: 
                   13542: Returns an id which can be used to pass environment variables
                   13543: to various cgi-bin scripts.  These environment variables will
                   13544: be removed from the users environment after a given time by
                   13545: the routine &Apache::lonnet::transfer_profile_to_env.
                   13546: 
                   13547: =cut
                   13548: 
                   13549: ############################################################
                   13550: ############################################################
1.152     albertel 13551: my $uniq=0;
1.136     matthew  13552: sub get_cgi_id {
1.154     albertel 13553:     $uniq=($uniq+1)%100000;
1.280     albertel 13554:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  13555: }
                   13556: 
1.127     matthew  13557: ############################################################
                   13558: ############################################################
                   13559: 
                   13560: =pod
                   13561: 
1.648     raeburn  13562: =item * &DrawBarGraph()
1.127     matthew  13563: 
1.138     matthew  13564: Facilitates the plotting of data in a (stacked) bar graph.
                   13565: Puts plot definition data into the users environment in order for 
                   13566: graph.png to plot it.  Returns an <img> tag for the plot.
                   13567: The bars on the plot are labeled '1','2',...,'n'.
                   13568: 
                   13569: Inputs:
                   13570: 
                   13571: =over 4
                   13572: 
                   13573: =item $Title: string, the title of the plot
                   13574: 
                   13575: =item $xlabel: string, text describing the X-axis of the plot
                   13576: 
                   13577: =item $ylabel: string, text describing the Y-axis of the plot
                   13578: 
                   13579: =item $Max: scalar, the maximum Y value to use in the plot
                   13580: If $Max is < any data point, the graph will not be rendered.
                   13581: 
1.140     matthew  13582: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  13583: they are plotted.  If undefined, default values will be used.
                   13584: 
1.178     matthew  13585: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   13586: 
1.138     matthew  13587: =item @Values: An array of array references.  Each array reference holds data
                   13588: to be plotted in a stacked bar chart.
                   13589: 
1.239     matthew  13590: =item If the final element of @Values is a hash reference the key/value
                   13591: pairs will be added to the graph definition.
                   13592: 
1.138     matthew  13593: =back
                   13594: 
                   13595: Returns:
                   13596: 
                   13597: An <img> tag which references graph.png and the appropriate identifying
                   13598: information for the plot.
                   13599: 
1.127     matthew  13600: =cut
                   13601: 
                   13602: ############################################################
                   13603: ############################################################
1.134     matthew  13604: sub DrawBarGraph {
1.178     matthew  13605:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  13606:     #
                   13607:     if (! defined($colors)) {
                   13608:         $colors = ['#33ff00', 
                   13609:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   13610:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   13611:                   ]; 
                   13612:     }
1.228     matthew  13613:     my $extra_settings = {};
                   13614:     if (ref($Values[-1]) eq 'HASH') {
                   13615:         $extra_settings = pop(@Values);
                   13616:     }
1.127     matthew  13617:     #
1.136     matthew  13618:     my $identifier = &get_cgi_id();
                   13619:     my $id = 'cgi.'.$identifier;        
1.129     matthew  13620:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  13621:         return '';
                   13622:     }
1.225     matthew  13623:     #
                   13624:     my @Labels;
                   13625:     if (defined($labels)) {
                   13626:         @Labels = @$labels;
                   13627:     } else {
                   13628:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   13629:             push (@Labels,$i+1);
                   13630:         }
                   13631:     }
                   13632:     #
1.129     matthew  13633:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  13634:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  13635:     my %ValuesHash;
                   13636:     my $NumSets=1;
                   13637:     foreach my $array (@Values) {
                   13638:         next if (! ref($array));
1.136     matthew  13639:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  13640:             join(',',@$array);
1.129     matthew  13641:     }
1.127     matthew  13642:     #
1.136     matthew  13643:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  13644:     if ($NumBars < 3) {
                   13645:         $width = 120+$NumBars*32;
1.220     matthew  13646:         $xskip = 1;
1.225     matthew  13647:         $bar_width = 30;
                   13648:     } elsif ($NumBars < 5) {
                   13649:         $width = 120+$NumBars*20;
                   13650:         $xskip = 1;
                   13651:         $bar_width = 20;
1.220     matthew  13652:     } elsif ($NumBars < 10) {
1.136     matthew  13653:         $width = 120+$NumBars*15;
                   13654:         $xskip = 1;
                   13655:         $bar_width = 15;
                   13656:     } elsif ($NumBars <= 25) {
                   13657:         $width = 120+$NumBars*11;
                   13658:         $xskip = 5;
                   13659:         $bar_width = 8;
                   13660:     } elsif ($NumBars <= 50) {
                   13661:         $width = 120+$NumBars*8;
                   13662:         $xskip = 5;
                   13663:         $bar_width = 4;
                   13664:     } else {
                   13665:         $width = 120+$NumBars*8;
                   13666:         $xskip = 5;
                   13667:         $bar_width = 4;
                   13668:     }
                   13669:     #
1.137     matthew  13670:     $Max = 1 if ($Max < 1);
                   13671:     if ( int($Max) < $Max ) {
                   13672:         $Max++;
                   13673:         $Max = int($Max);
                   13674:     }
1.127     matthew  13675:     $Title  = '' if (! defined($Title));
                   13676:     $xlabel = '' if (! defined($xlabel));
                   13677:     $ylabel = '' if (! defined($ylabel));
1.369     www      13678:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   13679:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   13680:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  13681:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  13682:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   13683:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   13684:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   13685:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13686:     $ValuesHash{$id.'.height'}   = $height;
                   13687:     $ValuesHash{$id.'.width'}    = $width;
                   13688:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   13689:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   13690:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  13691:     #
1.228     matthew  13692:     # Deal with other parameters
                   13693:     while (my ($key,$value) = each(%$extra_settings)) {
                   13694:         $ValuesHash{$id.'.'.$key} = $value;
                   13695:     }
                   13696:     #
1.646     raeburn  13697:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  13698:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13699: }
                   13700: 
                   13701: ############################################################
                   13702: ############################################################
                   13703: 
                   13704: =pod
                   13705: 
1.648     raeburn  13706: =item * &DrawXYGraph()
1.137     matthew  13707: 
1.138     matthew  13708: Facilitates the plotting of data in an XY graph.
                   13709: Puts plot definition data into the users environment in order for 
                   13710: graph.png to plot it.  Returns an <img> tag for the plot.
                   13711: 
                   13712: Inputs:
                   13713: 
                   13714: =over 4
                   13715: 
                   13716: =item $Title: string, the title of the plot
                   13717: 
                   13718: =item $xlabel: string, text describing the X-axis of the plot
                   13719: 
                   13720: =item $ylabel: string, text describing the Y-axis of the plot
                   13721: 
                   13722: =item $Max: scalar, the maximum Y value to use in the plot
                   13723: If $Max is < any data point, the graph will not be rendered.
                   13724: 
                   13725: =item $colors: Array ref containing the hex color codes for the data to be 
                   13726: plotted in.  If undefined, default values will be used.
                   13727: 
                   13728: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13729: 
                   13730: =item $Ydata: Array ref containing Array refs.  
1.185     www      13731: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  13732: 
                   13733: =item %Values: hash indicating or overriding any default values which are 
                   13734: passed to graph.png.  
                   13735: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13736: 
                   13737: =back
                   13738: 
                   13739: Returns:
                   13740: 
                   13741: An <img> tag which references graph.png and the appropriate identifying
                   13742: information for the plot.
                   13743: 
1.137     matthew  13744: =cut
                   13745: 
                   13746: ############################################################
                   13747: ############################################################
                   13748: sub DrawXYGraph {
                   13749:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   13750:     #
                   13751:     # Create the identifier for the graph
                   13752:     my $identifier = &get_cgi_id();
                   13753:     my $id = 'cgi.'.$identifier;
                   13754:     #
                   13755:     $Title  = '' if (! defined($Title));
                   13756:     $xlabel = '' if (! defined($xlabel));
                   13757:     $ylabel = '' if (! defined($ylabel));
                   13758:     my %ValuesHash = 
                   13759:         (
1.369     www      13760:          $id.'.title'  => &escape($Title),
                   13761:          $id.'.xlabel' => &escape($xlabel),
                   13762:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  13763:          $id.'.y_max_value'=> $Max,
                   13764:          $id.'.labels'     => join(',',@$Xlabels),
                   13765:          $id.'.PlotType'   => 'XY',
                   13766:          );
                   13767:     #
                   13768:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13769:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13770:     }
                   13771:     #
                   13772:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13773:         return '';
                   13774:     }
                   13775:     my $NumSets=1;
1.138     matthew  13776:     foreach my $array (@{$Ydata}){
1.137     matthew  13777:         next if (! ref($array));
                   13778:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13779:     }
1.138     matthew  13780:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13781:     #
                   13782:     # Deal with other parameters
                   13783:     while (my ($key,$value) = each(%Values)) {
                   13784:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13785:     }
                   13786:     #
1.646     raeburn  13787:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13788:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13789: }
                   13790: 
                   13791: ############################################################
                   13792: ############################################################
                   13793: 
                   13794: =pod
                   13795: 
1.648     raeburn  13796: =item * &DrawXYYGraph()
1.138     matthew  13797: 
                   13798: Facilitates the plotting of data in an XY graph with two Y axes.
                   13799: Puts plot definition data into the users environment in order for 
                   13800: graph.png to plot it.  Returns an <img> tag for the plot.
                   13801: 
                   13802: Inputs:
                   13803: 
                   13804: =over 4
                   13805: 
                   13806: =item $Title: string, the title of the plot
                   13807: 
                   13808: =item $xlabel: string, text describing the X-axis of the plot
                   13809: 
                   13810: =item $ylabel: string, text describing the Y-axis of the plot
                   13811: 
                   13812: =item $colors: Array ref containing the hex color codes for the data to be 
                   13813: plotted in.  If undefined, default values will be used.
                   13814: 
                   13815: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13816: 
                   13817: =item $Ydata1: The first data set
                   13818: 
                   13819: =item $Min1: The minimum value of the left Y-axis
                   13820: 
                   13821: =item $Max1: The maximum value of the left Y-axis
                   13822: 
                   13823: =item $Ydata2: The second data set
                   13824: 
                   13825: =item $Min2: The minimum value of the right Y-axis
                   13826: 
                   13827: =item $Max2: The maximum value of the left Y-axis
                   13828: 
                   13829: =item %Values: hash indicating or overriding any default values which are 
                   13830: passed to graph.png.  
                   13831: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13832: 
                   13833: =back
                   13834: 
                   13835: Returns:
                   13836: 
                   13837: An <img> tag which references graph.png and the appropriate identifying
                   13838: information for the plot.
1.136     matthew  13839: 
                   13840: =cut
                   13841: 
                   13842: ############################################################
                   13843: ############################################################
1.137     matthew  13844: sub DrawXYYGraph {
                   13845:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13846:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13847:     #
                   13848:     # Create the identifier for the graph
                   13849:     my $identifier = &get_cgi_id();
                   13850:     my $id = 'cgi.'.$identifier;
                   13851:     #
                   13852:     $Title  = '' if (! defined($Title));
                   13853:     $xlabel = '' if (! defined($xlabel));
                   13854:     $ylabel = '' if (! defined($ylabel));
                   13855:     my %ValuesHash = 
                   13856:         (
1.369     www      13857:          $id.'.title'  => &escape($Title),
                   13858:          $id.'.xlabel' => &escape($xlabel),
                   13859:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13860:          $id.'.labels' => join(',',@$Xlabels),
                   13861:          $id.'.PlotType' => 'XY',
                   13862:          $id.'.NumSets' => 2,
1.137     matthew  13863:          $id.'.two_axes' => 1,
                   13864:          $id.'.y1_max_value' => $Max1,
                   13865:          $id.'.y1_min_value' => $Min1,
                   13866:          $id.'.y2_max_value' => $Max2,
                   13867:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13868:          );
                   13869:     #
1.137     matthew  13870:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13871:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13872:     }
                   13873:     #
                   13874:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13875:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13876:         return '';
                   13877:     }
                   13878:     my $NumSets=1;
1.137     matthew  13879:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13880:         next if (! ref($array));
                   13881:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13882:     }
                   13883:     #
                   13884:     # Deal with other parameters
                   13885:     while (my ($key,$value) = each(%Values)) {
                   13886:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13887:     }
                   13888:     #
1.646     raeburn  13889:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13890:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13891: }
                   13892: 
                   13893: ############################################################
                   13894: ############################################################
                   13895: 
                   13896: =pod
                   13897: 
1.157     matthew  13898: =back 
                   13899: 
1.139     matthew  13900: =head1 Statistics helper routines?  
                   13901: 
                   13902: Bad place for them but what the hell.
                   13903: 
1.157     matthew  13904: =over 4
                   13905: 
1.648     raeburn  13906: =item * &chartlink()
1.139     matthew  13907: 
                   13908: Returns a link to the chart for a specific student.  
                   13909: 
                   13910: Inputs:
                   13911: 
                   13912: =over 4
                   13913: 
                   13914: =item $linktext: The text of the link
                   13915: 
                   13916: =item $sname: The students username
                   13917: 
                   13918: =item $sdomain: The students domain
                   13919: 
                   13920: =back
                   13921: 
1.157     matthew  13922: =back
                   13923: 
1.139     matthew  13924: =cut
                   13925: 
                   13926: ############################################################
                   13927: ############################################################
                   13928: sub chartlink {
                   13929:     my ($linktext, $sname, $sdomain) = @_;
                   13930:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13931:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13932:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13933:        '">'.$linktext.'</a>';
1.153     matthew  13934: }
                   13935: 
                   13936: #######################################################
                   13937: #######################################################
                   13938: 
                   13939: =pod
                   13940: 
                   13941: =head1 Course Environment Routines
1.157     matthew  13942: 
                   13943: =over 4
1.153     matthew  13944: 
1.648     raeburn  13945: =item * &restore_course_settings()
1.153     matthew  13946: 
1.648     raeburn  13947: =item * &store_course_settings()
1.153     matthew  13948: 
                   13949: Restores/Store indicated form parameters from the course environment.
                   13950: Will not overwrite existing values of the form parameters.
                   13951: 
                   13952: Inputs: 
                   13953: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13954: 
                   13955: a hash ref describing the data to be stored.  For example:
                   13956:    
                   13957: %Save_Parameters = ('Status' => 'scalar',
                   13958:     'chartoutputmode' => 'scalar',
                   13959:     'chartoutputdata' => 'scalar',
                   13960:     'Section' => 'array',
1.373     raeburn  13961:     'Group' => 'array',
1.153     matthew  13962:     'StudentData' => 'array',
                   13963:     'Maps' => 'array');
                   13964: 
                   13965: Returns: both routines return nothing
                   13966: 
1.631     raeburn  13967: =back
                   13968: 
1.153     matthew  13969: =cut
                   13970: 
                   13971: #######################################################
                   13972: #######################################################
                   13973: sub store_course_settings {
1.496     albertel 13974:     return &store_settings($env{'request.course.id'},@_);
                   13975: }
                   13976: 
                   13977: sub store_settings {
1.153     matthew  13978:     # save to the environment
                   13979:     # appenv the same items, just to be safe
1.300     albertel 13980:     my $udom  = $env{'user.domain'};
                   13981:     my $uname = $env{'user.name'};
1.496     albertel 13982:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13983:     my %SaveHash;
                   13984:     my %AppHash;
                   13985:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13986:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13987:         my $envname = 'environment.'.$basename;
1.258     albertel 13988:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13989:             # Save this value away
                   13990:             if ($type eq 'scalar' &&
1.258     albertel 13991:                 (! exists($env{$envname}) || 
                   13992:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13993:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13994:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13995:             } elsif ($type eq 'array') {
                   13996:                 my $stored_form;
1.258     albertel 13997:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13998:                     $stored_form = join(',',
                   13999:                                         map {
1.369     www      14000:                                             &escape($_);
1.258     albertel 14001:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  14002:                 } else {
                   14003:                     $stored_form = 
1.369     www      14004:                         &escape($env{'form.'.$setting});
1.153     matthew  14005:                 }
                   14006:                 # Determine if the array contents are the same.
1.258     albertel 14007:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  14008:                     $SaveHash{$basename} = $stored_form;
                   14009:                     $AppHash{$envname}   = $stored_form;
                   14010:                 }
                   14011:             }
                   14012:         }
                   14013:     }
                   14014:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 14015:                                           $udom,$uname);
1.153     matthew  14016:     if ($put_result !~ /^(ok|delayed)/) {
                   14017:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   14018:                                  'got error:'.$put_result);
                   14019:     }
                   14020:     # Make sure these settings stick around in this session, too
1.646     raeburn  14021:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  14022:     return;
                   14023: }
                   14024: 
                   14025: sub restore_course_settings {
1.499     albertel 14026:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 14027: }
                   14028: 
                   14029: sub restore_settings {
                   14030:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14031:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 14032:         next if (exists($env{'form.'.$setting}));
1.496     albertel 14033:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  14034:             '.'.$setting;
1.258     albertel 14035:         if (exists($env{$envname})) {
1.153     matthew  14036:             if ($type eq 'scalar') {
1.258     albertel 14037:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  14038:             } elsif ($type eq 'array') {
1.258     albertel 14039:                 $env{'form.'.$setting} = [ 
1.153     matthew  14040:                                            map { 
1.369     www      14041:                                                &unescape($_); 
1.258     albertel 14042:                                            } split(',',$env{$envname})
1.153     matthew  14043:                                            ];
                   14044:             }
                   14045:         }
                   14046:     }
1.127     matthew  14047: }
                   14048: 
1.618     raeburn  14049: #######################################################
                   14050: #######################################################
                   14051: 
                   14052: =pod
                   14053: 
                   14054: =head1 Domain E-mail Routines  
                   14055: 
                   14056: =over 4
                   14057: 
1.648     raeburn  14058: =item * &build_recipient_list()
1.618     raeburn  14059: 
1.1144    raeburn  14060: Build recipient lists for following types of e-mail:
1.766     raeburn  14061: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  14062: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   14063: module change checking, student/employee ID conflict checks, as
                   14064: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   14065: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  14066: 
                   14067: Inputs:
1.619     raeburn  14068: defmail (scalar - email address of default recipient), 
1.1144    raeburn  14069: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   14070: requestsmail, updatesmail, or idconflictsmail).
                   14071: 
1.619     raeburn  14072: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  14073: 
1.619     raeburn  14074: origmail (scalar - email address of recipient from loncapa.conf, 
                   14075: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  14076: 
1.655     raeburn  14077: Returns: comma separated list of addresses to which to send e-mail.
                   14078: 
                   14079: =back
1.618     raeburn  14080: 
                   14081: =cut
                   14082: 
                   14083: ############################################################
                   14084: ############################################################
                   14085: sub build_recipient_list {
1.619     raeburn  14086:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  14087:     my @recipients;
                   14088:     my $otheremails;
                   14089:     my %domconfig =
                   14090:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   14091:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  14092:         if (exists($domconfig{'contacts'}{$mailing})) {
                   14093:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   14094:                 my @contacts = ('adminemail','supportemail');
                   14095:                 foreach my $item (@contacts) {
                   14096:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   14097:                         my $addr = $domconfig{'contacts'}{$item}; 
                   14098:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14099:                             push(@recipients,$addr);
                   14100:                         }
1.619     raeburn  14101:                     }
1.766     raeburn  14102:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  14103:                 }
                   14104:             }
1.766     raeburn  14105:         } elsif ($origmail ne '') {
                   14106:             push(@recipients,$origmail);
1.618     raeburn  14107:         }
1.619     raeburn  14108:     } elsif ($origmail ne '') {
                   14109:         push(@recipients,$origmail);
1.618     raeburn  14110:     }
1.688     raeburn  14111:     if (defined($defmail)) {
                   14112:         if ($defmail ne '') {
                   14113:             push(@recipients,$defmail);
                   14114:         }
1.618     raeburn  14115:     }
                   14116:     if ($otheremails) {
1.619     raeburn  14117:         my @others;
                   14118:         if ($otheremails =~ /,/) {
                   14119:             @others = split(/,/,$otheremails);
1.618     raeburn  14120:         } else {
1.619     raeburn  14121:             push(@others,$otheremails);
                   14122:         }
                   14123:         foreach my $addr (@others) {
                   14124:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14125:                 push(@recipients,$addr);
                   14126:             }
1.618     raeburn  14127:         }
                   14128:     }
1.619     raeburn  14129:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  14130:     return $recipientlist;
                   14131: }
                   14132: 
1.127     matthew  14133: ############################################################
                   14134: ############################################################
1.154     albertel 14135: 
1.655     raeburn  14136: =pod
                   14137: 
1.1224    musolffc 14138: =over 4
                   14139: 
1.1223    musolffc 14140: =item * &mime_email()
                   14141: 
                   14142: Sends an email with a possible attachment
                   14143: 
                   14144: Inputs:
                   14145: 
                   14146: =over 4
                   14147: 
                   14148: from -              Sender's email address
                   14149: 
                   14150: to -                Email address of recipient
                   14151: 
                   14152: subject -           Subject of email
                   14153: 
                   14154: body -              Body of email
                   14155: 
                   14156: cc_string -         Carbon copy email address
                   14157: 
                   14158: bcc -               Blind carbon copy email address
                   14159: 
                   14160: type -              File type of attachment
                   14161: 
                   14162: attachment_path -   Path of file to be attached
                   14163: 
                   14164: file_name -         Name of file to be attached
                   14165: 
                   14166: attachment_text -   The body of an attachment of type "TEXT"
                   14167: 
                   14168: =back
                   14169: 
                   14170: =back
                   14171: 
                   14172: =cut
                   14173: 
                   14174: ############################################################
                   14175: ############################################################
                   14176: 
                   14177: sub mime_email {
                   14178:     my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
                   14179:         $file_name, $attachment_text) = @_;
                   14180:     my $msg = MIME::Lite->new(
                   14181:              From    => $from,
                   14182:              To      => $to,
                   14183:              Subject => $subject,
                   14184:              Type    =>'TEXT',
                   14185:              Data    => $body,
                   14186:              );
                   14187:     if ($cc_string ne '') {
                   14188:         $msg->add("Cc" => $cc_string);
                   14189:     }
                   14190:     if ($bcc ne '') {
                   14191:         $msg->add("Bcc" => $bcc);
                   14192:     }
                   14193:     $msg->attr("content-type"         => "text/plain");
                   14194:     $msg->attr("content-type.charset" => "UTF-8");
                   14195:     # Attach file if given
                   14196:     if ($attachment_path) {
                   14197:         unless ($file_name) {
                   14198:             if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
                   14199:         }
                   14200:         my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
                   14201:         $msg->attach(Type     => $type,
                   14202:                      Path     => $attachment_path,
                   14203:                      Filename => $file_name
                   14204:                      );
                   14205:     # Otherwise attach text if given
                   14206:     } elsif ($attachment_text) {
                   14207:         $msg->attach(Type => 'TEXT',
                   14208:                      Data => $attachment_text);
                   14209:     }
                   14210:     # Send it
                   14211:     $msg->send('sendmail');
                   14212: }
                   14213: 
                   14214: ############################################################
                   14215: ############################################################
                   14216: 
                   14217: =pod
                   14218: 
1.655     raeburn  14219: =head1 Course Catalog Routines
                   14220: 
                   14221: =over 4
                   14222: 
                   14223: =item * &gather_categories()
                   14224: 
                   14225: Converts category definitions - keys of categories hash stored in  
                   14226: coursecategories in configuration.db on the primary library server in a 
                   14227: domain - to an array.  Also generates javascript and idx hash used to 
                   14228: generate Domain Coordinator interface for editing Course Categories.
                   14229: 
                   14230: Inputs:
1.663     raeburn  14231: 
1.655     raeburn  14232: categories (reference to hash of category definitions).
1.663     raeburn  14233: 
1.655     raeburn  14234: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14235:       categories and subcategories).
1.663     raeburn  14236: 
1.655     raeburn  14237: idx (reference to hash of counters used in Domain Coordinator interface for 
                   14238:       editing Course Categories).
1.663     raeburn  14239: 
1.655     raeburn  14240: jsarray (reference to array of categories used to create Javascript arrays for
                   14241:          Domain Coordinator interface for editing Course Categories).
                   14242: 
                   14243: Returns: nothing
                   14244: 
                   14245: Side effects: populates cats, idx and jsarray. 
                   14246: 
                   14247: =cut
                   14248: 
                   14249: sub gather_categories {
                   14250:     my ($categories,$cats,$idx,$jsarray) = @_;
                   14251:     my %counters;
                   14252:     my $num = 0;
                   14253:     foreach my $item (keys(%{$categories})) {
                   14254:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   14255:         if ($container eq '' && $depth == 0) {
                   14256:             $cats->[$depth][$categories->{$item}] = $cat;
                   14257:         } else {
                   14258:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   14259:         }
                   14260:         my ($escitem,$tail) = split(/:/,$item,2);
                   14261:         if ($counters{$tail} eq '') {
                   14262:             $counters{$tail} = $num;
                   14263:             $num ++;
                   14264:         }
                   14265:         if (ref($idx) eq 'HASH') {
                   14266:             $idx->{$item} = $counters{$tail};
                   14267:         }
                   14268:         if (ref($jsarray) eq 'ARRAY') {
                   14269:             push(@{$jsarray->[$counters{$tail}]},$item);
                   14270:         }
                   14271:     }
                   14272:     return;
                   14273: }
                   14274: 
                   14275: =pod
                   14276: 
                   14277: =item * &extract_categories()
                   14278: 
                   14279: Used to generate breadcrumb trails for course categories.
                   14280: 
                   14281: Inputs:
1.663     raeburn  14282: 
1.655     raeburn  14283: categories (reference to hash of category definitions).
1.663     raeburn  14284: 
1.655     raeburn  14285: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14286:       categories and subcategories).
1.663     raeburn  14287: 
1.655     raeburn  14288: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  14289: 
1.655     raeburn  14290: allitems (reference to hash - key is category key 
                   14291:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14292: 
1.655     raeburn  14293: idx (reference to hash of counters used in Domain Coordinator interface for
                   14294:       editing Course Categories).
1.663     raeburn  14295: 
1.655     raeburn  14296: jsarray (reference to array of categories used to create Javascript arrays for
                   14297:          Domain Coordinator interface for editing Course Categories).
                   14298: 
1.665     raeburn  14299: subcats (reference to hash of arrays containing all subcategories within each 
                   14300:          category, -recursive)
                   14301: 
1.655     raeburn  14302: Returns: nothing
                   14303: 
                   14304: Side effects: populates trails and allitems hash references.
                   14305: 
                   14306: =cut
                   14307: 
                   14308: sub extract_categories {
1.665     raeburn  14309:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  14310:     if (ref($categories) eq 'HASH') {
                   14311:         &gather_categories($categories,$cats,$idx,$jsarray);
                   14312:         if (ref($cats->[0]) eq 'ARRAY') {
                   14313:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   14314:                 my $name = $cats->[0][$i];
                   14315:                 my $item = &escape($name).'::0';
                   14316:                 my $trailstr;
                   14317:                 if ($name eq 'instcode') {
                   14318:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  14319:                 } elsif ($name eq 'communities') {
                   14320:                     $trailstr = &mt('Communities');
1.1239    raeburn  14321:                 } elsif ($name eq 'placement') {
                   14322:                     $trailstr = &mt('Placement Tests');
1.655     raeburn  14323:                 } else {
                   14324:                     $trailstr = $name;
                   14325:                 }
                   14326:                 if ($allitems->{$item} eq '') {
                   14327:                     push(@{$trails},$trailstr);
                   14328:                     $allitems->{$item} = scalar(@{$trails})-1;
                   14329:                 }
                   14330:                 my @parents = ($name);
                   14331:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   14332:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   14333:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  14334:                         if (ref($subcats) eq 'HASH') {
                   14335:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   14336:                         }
                   14337:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   14338:                     }
                   14339:                 } else {
                   14340:                     if (ref($subcats) eq 'HASH') {
                   14341:                         $subcats->{$item} = [];
1.655     raeburn  14342:                     }
                   14343:                 }
                   14344:             }
                   14345:         }
                   14346:     }
                   14347:     return;
                   14348: }
                   14349: 
                   14350: =pod
                   14351: 
1.1162    raeburn  14352: =item * &recurse_categories()
1.655     raeburn  14353: 
                   14354: Recursively used to generate breadcrumb trails for course categories.
                   14355: 
                   14356: Inputs:
1.663     raeburn  14357: 
1.655     raeburn  14358: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14359:       categories and subcategories).
1.663     raeburn  14360: 
1.655     raeburn  14361: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  14362: 
                   14363: category (current course category, for which breadcrumb trail is being generated).
                   14364: 
                   14365: trails (reference to array of breadcrumb trails for each category).
                   14366: 
1.655     raeburn  14367: allitems (reference to hash - key is category key
                   14368:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14369: 
1.655     raeburn  14370: parents (array containing containers directories for current category, 
                   14371:          back to top level). 
                   14372: 
                   14373: Returns: nothing
                   14374: 
                   14375: Side effects: populates trails and allitems hash references
                   14376: 
                   14377: =cut
                   14378: 
                   14379: sub recurse_categories {
1.665     raeburn  14380:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  14381:     my $shallower = $depth - 1;
                   14382:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   14383:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   14384:             my $name = $cats->[$depth]{$category}[$k];
                   14385:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14386:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14387:             if ($allitems->{$item} eq '') {
                   14388:                 push(@{$trails},$trailstr);
                   14389:                 $allitems->{$item} = scalar(@{$trails})-1;
                   14390:             }
                   14391:             my $deeper = $depth+1;
                   14392:             push(@{$parents},$category);
1.665     raeburn  14393:             if (ref($subcats) eq 'HASH') {
                   14394:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   14395:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   14396:                     my $higher;
                   14397:                     if ($j > 0) {
                   14398:                         $higher = &escape($parents->[$j]).':'.
                   14399:                                   &escape($parents->[$j-1]).':'.$j;
                   14400:                     } else {
                   14401:                         $higher = &escape($parents->[$j]).'::'.$j;
                   14402:                     }
                   14403:                     push(@{$subcats->{$higher}},$subcat);
                   14404:                 }
                   14405:             }
                   14406:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   14407:                                 $subcats);
1.655     raeburn  14408:             pop(@{$parents});
                   14409:         }
                   14410:     } else {
                   14411:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14412:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14413:         if ($allitems->{$item} eq '') {
                   14414:             push(@{$trails},$trailstr);
                   14415:             $allitems->{$item} = scalar(@{$trails})-1;
                   14416:         }
                   14417:     }
                   14418:     return;
                   14419: }
                   14420: 
1.663     raeburn  14421: =pod
                   14422: 
1.1162    raeburn  14423: =item * &assign_categories_table()
1.663     raeburn  14424: 
                   14425: Create a datatable for display of hierarchical categories in a domain,
                   14426: with checkboxes to allow a course to be categorized. 
                   14427: 
                   14428: Inputs:
                   14429: 
                   14430: cathash - reference to hash of categories defined for the domain (from
                   14431:           configuration.db)
                   14432: 
                   14433: currcat - scalar with an & separated list of categories assigned to a course. 
                   14434: 
1.919     raeburn  14435: type    - scalar contains course type (Course or Community).
                   14436: 
1.663     raeburn  14437: Returns: $output (markup to be displayed) 
                   14438: 
                   14439: =cut
                   14440: 
                   14441: sub assign_categories_table {
1.919     raeburn  14442:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  14443:     my $output;
                   14444:     if (ref($cathash) eq 'HASH') {
                   14445:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   14446:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   14447:         $maxdepth = scalar(@cats);
                   14448:         if (@cats > 0) {
                   14449:             my $itemcount = 0;
                   14450:             if (ref($cats[0]) eq 'ARRAY') {
                   14451:                 my @currcategories;
                   14452:                 if ($currcat ne '') {
                   14453:                     @currcategories = split('&',$currcat);
                   14454:                 }
1.919     raeburn  14455:                 my $table;
1.663     raeburn  14456:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   14457:                     my $parent = $cats[0][$i];
1.919     raeburn  14458:                     next if ($parent eq 'instcode');
                   14459:                     if ($type eq 'Community') {
                   14460:                         next unless ($parent eq 'communities');
1.1239    raeburn  14461:                     } elsif ($type eq 'Placement') {
                   14462:                         next unless ($parent eq 'placement');
1.919     raeburn  14463:                     } else {
1.1239    raeburn  14464:                         next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919     raeburn  14465:                     }
1.663     raeburn  14466:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   14467:                     my $item = &escape($parent).'::0';
                   14468:                     my $checked = '';
                   14469:                     if (@currcategories > 0) {
                   14470:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   14471:                             $checked = ' checked="checked"';
1.663     raeburn  14472:                         }
                   14473:                     }
1.919     raeburn  14474:                     my $parent_title = $parent;
                   14475:                     if ($parent eq 'communities') {
                   14476:                         $parent_title = &mt('Communities');
1.1239    raeburn  14477:                     } elsif ($parent eq 'placement') {
                   14478:                         $parent_title = &mt('Placement Tests');
1.919     raeburn  14479:                     }
                   14480:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   14481:                               '<input type="checkbox" name="usecategory" value="'.
                   14482:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   14483:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  14484:                     my $depth = 1;
                   14485:                     push(@path,$parent);
1.919     raeburn  14486:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  14487:                     pop(@path);
1.919     raeburn  14488:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  14489:                     $itemcount ++;
                   14490:                 }
1.919     raeburn  14491:                 if ($itemcount) {
                   14492:                     $output = &Apache::loncommon::start_data_table().
                   14493:                               $table.
                   14494:                               &Apache::loncommon::end_data_table();
                   14495:                 }
1.663     raeburn  14496:             }
                   14497:         }
                   14498:     }
                   14499:     return $output;
                   14500: }
                   14501: 
                   14502: =pod
                   14503: 
1.1162    raeburn  14504: =item * &assign_category_rows()
1.663     raeburn  14505: 
                   14506: Create a datatable row for display of nested categories in a domain,
                   14507: with checkboxes to allow a course to be categorized,called recursively.
                   14508: 
                   14509: Inputs:
                   14510: 
                   14511: itemcount - track row number for alternating colors
                   14512: 
                   14513: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   14514:       categories and subcategories.
                   14515: 
                   14516: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   14517: 
                   14518: parent - parent of current category item
                   14519: 
                   14520: path - Array containing all categories back up through the hierarchy from the
                   14521:        current category to the top level.
                   14522: 
                   14523: currcategories - reference to array of current categories assigned to the course
                   14524: 
                   14525: Returns: $output (markup to be displayed).
                   14526: 
                   14527: =cut
                   14528: 
                   14529: sub assign_category_rows {
                   14530:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   14531:     my ($text,$name,$item,$chgstr);
                   14532:     if (ref($cats) eq 'ARRAY') {
                   14533:         my $maxdepth = scalar(@{$cats});
                   14534:         if (ref($cats->[$depth]) eq 'HASH') {
                   14535:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   14536:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   14537:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  14538:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  14539:                 for (my $j=0; $j<$numchildren; $j++) {
                   14540:                     $name = $cats->[$depth]{$parent}[$j];
                   14541:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   14542:                     my $deeper = $depth+1;
                   14543:                     my $checked = '';
                   14544:                     if (ref($currcategories) eq 'ARRAY') {
                   14545:                         if (@{$currcategories} > 0) {
                   14546:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   14547:                                 $checked = ' checked="checked"';
1.663     raeburn  14548:                             }
                   14549:                         }
                   14550:                     }
1.664     raeburn  14551:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   14552:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  14553:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   14554:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   14555:                              '</td><td>';
1.663     raeburn  14556:                     if (ref($path) eq 'ARRAY') {
                   14557:                         push(@{$path},$name);
                   14558:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   14559:                         pop(@{$path});
                   14560:                     }
                   14561:                     $text .= '</td></tr>';
                   14562:                 }
                   14563:                 $text .= '</table></td>';
                   14564:             }
                   14565:         }
                   14566:     }
                   14567:     return $text;
                   14568: }
                   14569: 
1.1181    raeburn  14570: =pod
                   14571: 
                   14572: =back
                   14573: 
                   14574: =cut
                   14575: 
1.655     raeburn  14576: ############################################################
                   14577: ############################################################
                   14578: 
                   14579: 
1.443     albertel 14580: sub commit_customrole {
1.664     raeburn  14581:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  14582:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 14583:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   14584:                          ($end?', ending '.localtime($end):'').': <b>'.
                   14585:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  14586:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 14587:                  '</b><br />';
                   14588:     return $output;
                   14589: }
                   14590: 
                   14591: sub commit_standardrole {
1.1116    raeburn  14592:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  14593:     my ($output,$logmsg,$linefeed);
                   14594:     if ($context eq 'auto') {
                   14595:         $linefeed = "\n";
                   14596:     } else {
                   14597:         $linefeed = "<br />\n";
                   14598:     }  
1.443     albertel 14599:     if ($three eq 'st') {
1.541     raeburn  14600:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  14601:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  14602:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  14603:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   14604:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 14605:         } else {
1.541     raeburn  14606:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 14607:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14608:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   14609:             if ($context eq 'auto') {
                   14610:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   14611:             } else {
                   14612:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   14613:                &mt('Add to classlist').': <b>ok</b>';
                   14614:             }
                   14615:             $output .= $linefeed;
1.443     albertel 14616:         }
                   14617:     } else {
                   14618:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   14619:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14620:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  14621:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  14622:         if ($context eq 'auto') {
                   14623:             $output .= $result.$linefeed;
                   14624:         } else {
                   14625:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   14626:         }
1.443     albertel 14627:     }
                   14628:     return $output;
                   14629: }
                   14630: 
                   14631: sub commit_studentrole {
1.1116    raeburn  14632:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   14633:         $credits) = @_;
1.626     raeburn  14634:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  14635:     if ($context eq 'auto') {
                   14636:         $linefeed = "\n";
                   14637:     } else {
                   14638:         $linefeed = '<br />'."\n";
                   14639:     }
1.443     albertel 14640:     if (defined($one) && defined($two)) {
                   14641:         my $cid=$one.'_'.$two;
                   14642:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   14643:         my $secchange = 0;
                   14644:         my $expire_role_result;
                   14645:         my $modify_section_result;
1.628     raeburn  14646:         if ($oldsec ne '-1') { 
                   14647:             if ($oldsec ne $sec) {
1.443     albertel 14648:                 $secchange = 1;
1.628     raeburn  14649:                 my $now = time;
1.443     albertel 14650:                 my $uurl='/'.$cid;
                   14651:                 $uurl=~s/\_/\//g;
                   14652:                 if ($oldsec) {
                   14653:                     $uurl.='/'.$oldsec;
                   14654:                 }
1.626     raeburn  14655:                 $oldsecurl = $uurl;
1.628     raeburn  14656:                 $expire_role_result = 
1.652     raeburn  14657:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  14658:                 if ($env{'request.course.sec'} ne '') { 
                   14659:                     if ($expire_role_result eq 'refused') {
                   14660:                         my @roles = ('st');
                   14661:                         my @statuses = ('previous');
                   14662:                         my @roledoms = ($one);
                   14663:                         my $withsec = 1;
                   14664:                         my %roleshash = 
                   14665:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   14666:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   14667:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   14668:                             my ($oldstart,$oldend) = 
                   14669:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   14670:                             if ($oldend > 0 && $oldend <= $now) {
                   14671:                                 $expire_role_result = 'ok';
                   14672:                             }
                   14673:                         }
                   14674:                     }
                   14675:                 }
1.443     albertel 14676:                 $result = $expire_role_result;
                   14677:             }
                   14678:         }
                   14679:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  14680:             $modify_section_result = 
                   14681:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   14682:                                                            undef,undef,undef,$sec,
                   14683:                                                            $end,$start,'','',$cid,
                   14684:                                                            '',$context,$credits);
1.443     albertel 14685:             if ($modify_section_result =~ /^ok/) {
                   14686:                 if ($secchange == 1) {
1.628     raeburn  14687:                     if ($sec eq '') {
                   14688:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   14689:                     } else {
                   14690:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   14691:                     }
1.443     albertel 14692:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  14693:                     if ($sec eq '') {
                   14694:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   14695:                     } else {
                   14696:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14697:                     }
1.443     albertel 14698:                 } else {
1.628     raeburn  14699:                     if ($sec eq '') {
                   14700:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   14701:                     } else {
                   14702:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14703:                     }
1.443     albertel 14704:                 }
                   14705:             } else {
1.1115    raeburn  14706:                 if ($secchange) { 
1.628     raeburn  14707:                     $$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;
                   14708:                 } else {
                   14709:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   14710:                 }
1.443     albertel 14711:             }
                   14712:             $result = $modify_section_result;
                   14713:         } elsif ($secchange == 1) {
1.628     raeburn  14714:             if ($oldsec eq '') {
1.1103    raeburn  14715:                 $$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  14716:             } else {
                   14717:                 $$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;
                   14718:             }
1.626     raeburn  14719:             if ($expire_role_result eq 'refused') {
                   14720:                 my $newsecurl = '/'.$cid;
                   14721:                 $newsecurl =~ s/\_/\//g;
                   14722:                 if ($sec ne '') {
                   14723:                     $newsecurl.='/'.$sec;
                   14724:                 }
                   14725:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   14726:                     if ($sec eq '') {
                   14727:                         $$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;
                   14728:                     } else {
                   14729:                         $$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;
                   14730:                     }
                   14731:                 }
                   14732:             }
1.443     albertel 14733:         }
                   14734:     } else {
1.626     raeburn  14735:         $$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 14736:         $result = "error: incomplete course id\n";
                   14737:     }
                   14738:     return $result;
                   14739: }
                   14740: 
1.1108    raeburn  14741: sub show_role_extent {
                   14742:     my ($scope,$context,$role) = @_;
                   14743:     $scope =~ s{^/}{};
                   14744:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   14745:     push(@courseroles,'co');
                   14746:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   14747:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   14748:         $scope =~ s{/}{_};
                   14749:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   14750:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   14751:         my ($audom,$auname) = split(/\//,$scope);
                   14752:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   14753:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   14754:     } else {
                   14755:         $scope =~ s{/$}{};
                   14756:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   14757:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   14758:     }
                   14759: }
                   14760: 
1.443     albertel 14761: ############################################################
                   14762: ############################################################
                   14763: 
1.566     albertel 14764: sub check_clone {
1.578     raeburn  14765:     my ($args,$linefeed) = @_;
1.566     albertel 14766:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   14767:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   14768:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   14769:     my $clonemsg;
                   14770:     my $can_clone = 0;
1.944     raeburn  14771:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  14772:     if ($lctype ne 'community') {
                   14773:         $lctype = 'course';
                   14774:     }
1.566     albertel 14775:     if ($clonehome eq 'no_host') {
1.944     raeburn  14776:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14777:             $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'});
                   14778:         } else {
                   14779:             $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'});
                   14780:         }     
1.566     albertel 14781:     } else {
                   14782: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  14783:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14784:             if ($clonedesc{'type'} ne 'Community') {
                   14785:                  $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'});
                   14786:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14787:             }
                   14788:         }
1.882     raeburn  14789: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   14790:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 14791: 	    $can_clone = 1;
                   14792: 	} else {
1.1221    raeburn  14793: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 14794: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1221    raeburn  14795:             if ($clonehash{'cloners'} eq '') {
                   14796:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   14797:                 if ($domdefs{'canclone'}) {
                   14798:                     unless ($domdefs{'canclone'} eq 'none') {
                   14799:                         if ($domdefs{'canclone'} eq 'domain') {
                   14800:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   14801:                                 $can_clone = 1;
                   14802:                             }
                   14803:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   14804:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   14805:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   14806:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   14807:                                 $can_clone = 1;
                   14808:                             }
                   14809:                         }
                   14810:                     }
                   14811:                 }
1.578     raeburn  14812:             } else {
1.1221    raeburn  14813: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   14814:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  14815:                     $can_clone = 1;
1.1221    raeburn  14816:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  14817:                     $can_clone = 1;
1.1225    raeburn  14818:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   14819:                     $can_clone = 1;
1.1221    raeburn  14820:                 }
                   14821:                 unless ($can_clone) {
1.1225    raeburn  14822:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   14823:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1221    raeburn  14824:                         my (%gotdomdefaults,%gotcodedefaults);
                   14825:                         foreach my $cloner (@cloners) {
                   14826:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   14827:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   14828:                                 my (%codedefaults,@code_order);
                   14829:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   14830:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   14831:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   14832:                                     }
                   14833:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   14834:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   14835:                                     }
                   14836:                                 } else {
                   14837:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   14838:                                                                             \%codedefaults,
                   14839:                                                                             \@code_order);
                   14840:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   14841:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   14842:                                 }
                   14843:                                 if (@code_order > 0) {
                   14844:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   14845:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   14846:                                                                                 $args->{'crscode'})) {
                   14847:                                         $can_clone = 1;
                   14848:                                         last;
                   14849:                                     }
                   14850:                                 }
                   14851:                             }
                   14852:                         }
                   14853:                     }
1.1225    raeburn  14854:                 }
                   14855:             }
                   14856:             unless ($can_clone) {
                   14857:                 my $ccrole = 'cc';
                   14858:                 if ($args->{'crstype'} eq 'Community') {
                   14859:                     $ccrole = 'co';
                   14860:                 }
                   14861: 	        my %roleshash =
                   14862: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   14863: 					          $args->{'ccdomain'},
                   14864:                                                   'userroles',['active'],[$ccrole],
                   14865: 					          [$args->{'clonedomain'}]);
                   14866: 	        if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   14867:                     $can_clone = 1;
                   14868:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   14869:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   14870:                     $can_clone = 1;
1.1221    raeburn  14871:                 }
                   14872:             }
                   14873:             unless ($can_clone) {
                   14874:                 if ($args->{'crstype'} eq 'Community') {
                   14875:                     $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  14876:                 } else {
1.1221    raeburn  14877:                     $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'});
                   14878:                 }
1.566     albertel 14879: 	    }
1.578     raeburn  14880:         }
1.566     albertel 14881:     }
                   14882:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14883: }
                   14884: 
1.444     albertel 14885: sub construct_course {
1.1166    raeburn  14886:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 14887:     my $outcome;
1.541     raeburn  14888:     my $linefeed =  '<br />'."\n";
                   14889:     if ($context eq 'auto') {
                   14890:         $linefeed = "\n";
                   14891:     }
1.566     albertel 14892: 
                   14893: #
                   14894: # Are we cloning?
                   14895: #
                   14896:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14897:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  14898: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 14899: 	if ($context ne 'auto') {
1.578     raeburn  14900:             if ($clonemsg ne '') {
                   14901: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   14902:             }
1.566     albertel 14903: 	}
                   14904: 	$outcome .= $clonemsg.$linefeed;
                   14905: 
                   14906:         if (!$can_clone) {
                   14907: 	    return (0,$outcome);
                   14908: 	}
                   14909:     }
                   14910: 
1.444     albertel 14911: #
                   14912: # Open course
                   14913: #
1.1239    raeburn  14914:     my $showncrstype;
                   14915:     if ($args->{'crstype'} eq 'Placement') {
                   14916:         $showncrstype = 'placement test'; 
                   14917:     } else {  
                   14918:         $showncrstype = lc($args->{'crstype'});
                   14919:     }
1.444     albertel 14920:     my %cenv=();
                   14921:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   14922:                                              $args->{'cdescr'},
                   14923:                                              $args->{'curl'},
                   14924:                                              $args->{'course_home'},
                   14925:                                              $args->{'nonstandard'},
                   14926:                                              $args->{'crscode'},
                   14927:                                              $args->{'ccuname'}.':'.
                   14928:                                              $args->{'ccdomain'},
1.882     raeburn  14929:                                              $args->{'crstype'},
1.885     raeburn  14930:                                              $cnum,$context,$category);
1.444     albertel 14931: 
                   14932:     # Note: The testing routines depend on this being output; see 
                   14933:     # Utils::Course. This needs to at least be output as a comment
                   14934:     # if anyone ever decides to not show this, and Utils::Course::new
                   14935:     # will need to be suitably modified.
1.1239    raeburn  14936:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943     raeburn  14937:     if ($$courseid =~ /^error:/) {
                   14938:         return (0,$outcome);
                   14939:     }
                   14940: 
1.444     albertel 14941: #
                   14942: # Check if created correctly
                   14943: #
1.479     albertel 14944:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14945:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14946:     if ($crsuhome eq 'no_host') {
                   14947:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14948:         return (0,$outcome);
                   14949:     }
1.541     raeburn  14950:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14951: 
1.444     albertel 14952: #
1.566     albertel 14953: # Do the cloning
                   14954: #   
                   14955:     if ($can_clone && $cloneid) {
1.1239    raeburn  14956: 	$clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566     albertel 14957: 	if ($context ne 'auto') {
                   14958: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14959: 	}
                   14960: 	$outcome .= $clonemsg.$linefeed;
                   14961: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14962: # Copy all files
1.637     www      14963: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14964: # Restore URL
1.566     albertel 14965: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14966: # Restore title
1.566     albertel 14967: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14968: # Restore creation date, creator and creation context.
                   14969:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14970:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14971:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14972: # Mark as cloned
1.566     albertel 14973: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14974: # Need to clone grading mode
                   14975:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14976:         $cenv{'grading'}=$newenv{'grading'};
                   14977: # Do not clone these environment entries
                   14978:         &Apache::lonnet::del('environment',
                   14979:                   ['default_enrollment_start_date',
                   14980:                    'default_enrollment_end_date',
                   14981:                    'question.email',
                   14982:                    'policy.email',
                   14983:                    'comment.email',
                   14984:                    'pch.users.denied',
1.725     raeburn  14985:                    'plc.users.denied',
                   14986:                    'hidefromcat',
1.1121    raeburn  14987:                    'checkforpriv',
1.1166    raeburn  14988:                    'categories',
                   14989:                    'internal.uniquecode'],
1.638     www      14990:                    $$crsudom,$$crsunum);
1.1170    raeburn  14991:         if ($args->{'textbook'}) {
                   14992:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14993:         }
1.444     albertel 14994:     }
1.566     albertel 14995: 
1.444     albertel 14996: #
                   14997: # Set environment (will override cloned, if existing)
                   14998: #
                   14999:     my @sections = ();
                   15000:     my @xlists = ();
                   15001:     if ($args->{'crstype'}) {
                   15002:         $cenv{'type'}=$args->{'crstype'};
                   15003:     }
                   15004:     if ($args->{'crsid'}) {
                   15005:         $cenv{'courseid'}=$args->{'crsid'};
                   15006:     }
                   15007:     if ($args->{'crscode'}) {
                   15008:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   15009:     }
                   15010:     if ($args->{'crsquota'} ne '') {
                   15011:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   15012:     } else {
                   15013:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   15014:     }
                   15015:     if ($args->{'ccuname'}) {
                   15016:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   15017:                                         ':'.$args->{'ccdomain'};
                   15018:     } else {
                   15019:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   15020:     }
1.1116    raeburn  15021:     if ($args->{'defaultcredits'}) {
                   15022:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   15023:     }
1.444     albertel 15024:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   15025:     if ($args->{'crssections'}) {
                   15026:         $cenv{'internal.sectionnums'} = '';
                   15027:         if ($args->{'crssections'} =~ m/,/) {
                   15028:             @sections = split/,/,$args->{'crssections'};
                   15029:         } else {
                   15030:             $sections[0] = $args->{'crssections'};
                   15031:         }
                   15032:         if (@sections > 0) {
                   15033:             foreach my $item (@sections) {
                   15034:                 my ($sec,$gp) = split/:/,$item;
                   15035:                 my $class = $args->{'crscode'}.$sec;
                   15036:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   15037:                 $cenv{'internal.sectionnums'} .= $item.',';
                   15038:                 unless ($addcheck eq 'ok') {
                   15039:                     push @badclasses, $class;
                   15040:                 }
                   15041:             }
                   15042:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   15043:         }
                   15044:     }
                   15045: # do not hide course coordinator from staff listing, 
                   15046: # even if privileged
                   15047:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  15048: # add course coordinator's domain to domains to check for privileged users
                   15049: # if different to course domain
                   15050:     if ($$crsudom ne $args->{'ccdomain'}) {
                   15051:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   15052:     }
1.444     albertel 15053: # add crosslistings
                   15054:     if ($args->{'crsxlist'}) {
                   15055:         $cenv{'internal.crosslistings'}='';
                   15056:         if ($args->{'crsxlist'} =~ m/,/) {
                   15057:             @xlists = split/,/,$args->{'crsxlist'};
                   15058:         } else {
                   15059:             $xlists[0] = $args->{'crsxlist'};
                   15060:         }
                   15061:         if (@xlists > 0) {
                   15062:             foreach my $item (@xlists) {
                   15063:                 my ($xl,$gp) = split/:/,$item;
                   15064:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   15065:                 $cenv{'internal.crosslistings'} .= $item.',';
                   15066:                 unless ($addcheck eq 'ok') {
                   15067:                     push @badclasses, $xl;
                   15068:                 }
                   15069:             }
                   15070:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   15071:         }
                   15072:     }
                   15073:     if ($args->{'autoadds'}) {
                   15074:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   15075:     }
                   15076:     if ($args->{'autodrops'}) {
                   15077:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   15078:     }
                   15079: # check for notification of enrollment changes
                   15080:     my @notified = ();
                   15081:     if ($args->{'notify_owner'}) {
                   15082:         if ($args->{'ccuname'} ne '') {
                   15083:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   15084:         }
                   15085:     }
                   15086:     if ($args->{'notify_dc'}) {
                   15087:         if ($uname ne '') { 
1.630     raeburn  15088:             push(@notified,$uname.':'.$udom);
1.444     albertel 15089:         }
                   15090:     }
                   15091:     if (@notified > 0) {
                   15092:         my $notifylist;
                   15093:         if (@notified > 1) {
                   15094:             $notifylist = join(',',@notified);
                   15095:         } else {
                   15096:             $notifylist = $notified[0];
                   15097:         }
                   15098:         $cenv{'internal.notifylist'} = $notifylist;
                   15099:     }
                   15100:     if (@badclasses > 0) {
                   15101:         my %lt=&Apache::lonlocal::texthash(
                   15102:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
                   15103:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   15104:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   15105:         );
1.541     raeburn  15106:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   15107:                            ' ('.$lt{'adby'}.')';
                   15108:         if ($context eq 'auto') {
                   15109:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 15110:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  15111:             foreach my $item (@badclasses) {
                   15112:                 if ($context eq 'auto') {
                   15113:                     $outcome .= " - $item\n";
                   15114:                 } else {
                   15115:                     $outcome .= "<li>$item</li>\n";
                   15116:                 }
                   15117:             }
                   15118:             if ($context eq 'auto') {
                   15119:                 $outcome .= $linefeed;
                   15120:             } else {
1.566     albertel 15121:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  15122:             }
                   15123:         } 
1.444     albertel 15124:     }
                   15125:     if ($args->{'no_end_date'}) {
                   15126:         $args->{'endaccess'} = 0;
                   15127:     }
                   15128:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   15129:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   15130:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   15131:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   15132:     if ($args->{'showphotos'}) {
                   15133:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   15134:     }
                   15135:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   15136:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   15137:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   15138:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  15139:             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'); 
                   15140:             if ($context eq 'auto') {
                   15141:                 $outcome .= $krb_msg;
                   15142:             } else {
1.566     albertel 15143:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  15144:             }
                   15145:             $outcome .= $linefeed;
1.444     albertel 15146:         }
                   15147:     }
                   15148:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   15149:        if ($args->{'setpolicy'}) {
                   15150:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15151:        }
                   15152:        if ($args->{'setcontent'}) {
                   15153:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15154:        }
                   15155:     }
                   15156:     if ($args->{'reshome'}) {
                   15157: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   15158: 	$cenv{'reshome'}=~s/\/+$/\//;
                   15159:     }
                   15160: #
                   15161: # course has keyed access
                   15162: #
                   15163:     if ($args->{'setkeys'}) {
                   15164:        $cenv{'keyaccess'}='yes';
                   15165:     }
                   15166: # if specified, key authority is not course, but user
                   15167: # only active if keyaccess is yes
                   15168:     if ($args->{'keyauth'}) {
1.487     albertel 15169: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   15170: 	$user = &LONCAPA::clean_username($user);
                   15171: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     15172: 	if ($user ne '' && $domain ne '') {
1.487     albertel 15173: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 15174: 	}
                   15175:     }
                   15176: 
1.1166    raeburn  15177: #
1.1167    raeburn  15178: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  15179: #
                   15180:     if ($args->{'uniquecode'}) {
                   15181:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   15182:         if ($code) {
                   15183:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  15184:             my %crsinfo =
                   15185:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   15186:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   15187:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   15188:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   15189:             } 
1.1166    raeburn  15190:             if (ref($coderef)) {
                   15191:                 $$coderef = $code;
                   15192:             }
                   15193:         }
                   15194:     }
                   15195: 
1.444     albertel 15196:     if ($args->{'disresdis'}) {
                   15197:         $cenv{'pch.roles.denied'}='st';
                   15198:     }
                   15199:     if ($args->{'disablechat'}) {
                   15200:         $cenv{'plc.roles.denied'}='st';
                   15201:     }
                   15202: 
                   15203:     # Record we've not yet viewed the Course Initialization Helper for this 
                   15204:     # course
                   15205:     $cenv{'course.helper.not.run'} = 1;
                   15206:     #
                   15207:     # Use new Randomseed
                   15208:     #
                   15209:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   15210:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   15211:     #
                   15212:     # The encryption code and receipt prefix for this course
                   15213:     #
                   15214:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   15215:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   15216:     #
                   15217:     # By default, use standard grading
                   15218:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   15219: 
1.541     raeburn  15220:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   15221:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15222: #
                   15223: # Open all assignments
                   15224: #
                   15225:     if ($args->{'openall'}) {
                   15226:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   15227:        my %storecontent = ($storeunder         => time,
                   15228:                            $storeunder.'.type' => 'date_start');
                   15229:        
                   15230:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  15231:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15232:    }
                   15233: #
                   15234: # Set first page
                   15235: #
                   15236:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   15237: 	    || ($cloneid)) {
1.445     albertel 15238: 	use LONCAPA::map;
1.444     albertel 15239: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 15240: 
                   15241: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   15242:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   15243: 
1.444     albertel 15244:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   15245:         my $title; my $url;
                   15246:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   15247: 	    $title=&mt('Syllabus');
1.444     albertel 15248:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   15249:         } else {
1.963     raeburn  15250:             $title=&mt('Table of Contents');
1.444     albertel 15251:             $url='/adm/navmaps';
                   15252:         }
1.445     albertel 15253: 
                   15254:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   15255: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   15256: 
                   15257: 	if ($errtext) { $fatal=2; }
1.541     raeburn  15258:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 15259:     }
1.566     albertel 15260: 
1.1237    raeburn  15261: # 
                   15262: # Set params for Placement Tests
                   15263: #
1.1239    raeburn  15264:     if ($args->{'crstype'} eq 'Placement') {
                   15265:        my %storecontent; 
                   15266:        my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
                   15267:        my %defaults = (
                   15268:                         buttonshide   => { value => 'yes',
                   15269:                                            type => 'string_yesno',},
                   15270:                         type          => { value => 'randomizetry',
                   15271:                                            type  => 'string_questiontype',},
                   15272:                         maxtries      => { value => 1,
                   15273:                                            type => 'int_pos',},
                   15274:                         problemstatus => { value => 'no',
                   15275:                                            type  => 'string_problemstatus',},
                   15276:                       );
                   15277:        foreach my $key (keys(%defaults)) {
                   15278:            $storecontent{$prefix.$key} = $defaults{$key}{'value'};
                   15279:            $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
                   15280:        }
1.1237    raeburn  15281:        &Apache::lonnet::cput
                   15282:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
                   15283:     }
                   15284: 
1.566     albertel 15285:     return (1,$outcome);
1.444     albertel 15286: }
                   15287: 
1.1166    raeburn  15288: sub make_unique_code {
                   15289:     my ($cdom,$cnum) = @_;
                   15290:     # get lock on uniquecodes db
                   15291:     my $lockhash = {
                   15292:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   15293:                                                   ':'.$env{'user.domain'},
                   15294:                    };
                   15295:     my $tries = 0;
                   15296:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15297:     my ($code,$error);
                   15298:   
                   15299:     while (($gotlock ne 'ok') && ($tries<3)) {
                   15300:         $tries ++;
                   15301:         sleep 1;
                   15302:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15303:     }
                   15304:     if ($gotlock eq 'ok') {
                   15305:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   15306:         my $gotcode;
                   15307:         my $attempts = 0;
                   15308:         while ((!$gotcode) && ($attempts < 100)) {
                   15309:             $code = &generate_code();
                   15310:             if (!exists($currcodes{$code})) {
                   15311:                 $gotcode = 1;
                   15312:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   15313:                     $error = 'nostore';
                   15314:                 }
                   15315:             }
                   15316:             $attempts ++;
                   15317:         }
                   15318:         my @del_lock = ($cnum."\0".'uniquecodes');
                   15319:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   15320:     } else {
                   15321:         $error = 'nolock';
                   15322:     }
                   15323:     return ($code,$error);
                   15324: }
                   15325: 
                   15326: sub generate_code {
                   15327:     my $code;
                   15328:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   15329:     for (my $i=0; $i<6; $i++) {
                   15330:         my $lettnum = int (rand 2);
                   15331:         my $item = '';
                   15332:         if ($lettnum) {
                   15333:             $item = $letts[int( rand(18) )];
                   15334:         } else {
                   15335:             $item = 1+int( rand(8) );
                   15336:         }
                   15337:         $code .= $item;
                   15338:     }
                   15339:     return $code;
                   15340: }
                   15341: 
1.444     albertel 15342: ############################################################
                   15343: ############################################################
                   15344: 
1.1237    raeburn  15345: # Community, Course and Placement Test
1.378     raeburn  15346: sub course_type {
                   15347:     my ($cid) = @_;
                   15348:     if (!defined($cid)) {
                   15349:         $cid = $env{'request.course.id'};
                   15350:     }
1.404     albertel 15351:     if (defined($env{'course.'.$cid.'.type'})) {
                   15352:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  15353:     } else {
                   15354:         return 'Course';
1.377     raeburn  15355:     }
                   15356: }
1.156     albertel 15357: 
1.406     raeburn  15358: sub group_term {
                   15359:     my $crstype = &course_type();
                   15360:     my %names = (
                   15361:                   'Course' => 'group',
1.865     raeburn  15362:                   'Community' => 'group',
1.1237    raeburn  15363:                   'Placement' => 'group',
1.406     raeburn  15364:                 );
                   15365:     return $names{$crstype};
                   15366: }
                   15367: 
1.902     raeburn  15368: sub course_types {
1.1237    raeburn  15369:     my @types = ('official','unofficial','community','textbook','placement');
1.902     raeburn  15370:     my %typename = (
                   15371:                          official   => 'Official course',
                   15372:                          unofficial => 'Unofficial course',
                   15373:                          community  => 'Community',
1.1165    raeburn  15374:                          textbook   => 'Textbook course',
1.1237    raeburn  15375:                          placement  => 'Placement test',
1.902     raeburn  15376:                    );
                   15377:     return (\@types,\%typename);
                   15378: }
                   15379: 
1.156     albertel 15380: sub icon {
                   15381:     my ($file)=@_;
1.505     albertel 15382:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 15383:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 15384:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 15385:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   15386: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   15387: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15388: 	            $curfext.".gif") {
                   15389: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15390: 		$curfext.".gif";
                   15391: 	}
                   15392:     }
1.249     albertel 15393:     return &lonhttpdurl($iconname);
1.154     albertel 15394: } 
1.84      albertel 15395: 
1.575     albertel 15396: sub lonhttpdurl {
1.692     www      15397: #
                   15398: # Had been used for "small fry" static images on separate port 8080.
                   15399: # Modify here if lightweight http functionality desired again.
                   15400: # Currently eliminated due to increasing firewall issues.
                   15401: #
1.575     albertel 15402:     my ($url)=@_;
1.692     www      15403:     return $url;
1.215     albertel 15404: }
                   15405: 
1.213     albertel 15406: sub connection_aborted {
                   15407:     my ($r)=@_;
                   15408:     $r->print(" ");$r->rflush();
                   15409:     my $c = $r->connection;
                   15410:     return $c->aborted();
                   15411: }
                   15412: 
1.221     foxr     15413: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     15414: #    strings as 'strings'.
                   15415: sub escape_single {
1.221     foxr     15416:     my ($input) = @_;
1.223     albertel 15417:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     15418:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   15419:     return $input;
                   15420: }
1.223     albertel 15421: 
1.222     foxr     15422: #  Same as escape_single, but escape's "'s  This 
                   15423: #  can be used for  "strings"
                   15424: sub escape_double {
                   15425:     my ($input) = @_;
                   15426:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   15427:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   15428:     return $input;
                   15429: }
1.223     albertel 15430:  
1.222     foxr     15431: #   Escapes the last element of a full URL.
                   15432: sub escape_url {
                   15433:     my ($url)   = @_;
1.238     raeburn  15434:     my @urlslices = split(/\//, $url,-1);
1.369     www      15435:     my $lastitem = &escape(pop(@urlslices));
1.1203    raeburn  15436:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     15437: }
1.462     albertel 15438: 
1.820     raeburn  15439: sub compare_arrays {
                   15440:     my ($arrayref1,$arrayref2) = @_;
                   15441:     my (@difference,%count);
                   15442:     @difference = ();
                   15443:     %count = ();
                   15444:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   15445:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   15446:         foreach my $element (keys(%count)) {
                   15447:             if ($count{$element} == 1) {
                   15448:                 push(@difference,$element);
                   15449:             }
                   15450:         }
                   15451:     }
                   15452:     return @difference;
                   15453: }
                   15454: 
1.817     bisitz   15455: # -------------------------------------------------------- Initialize user login
1.462     albertel 15456: sub init_user_environment {
1.463     albertel 15457:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 15458:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   15459: 
                   15460:     my $public=($username eq 'public' && $domain eq 'public');
                   15461: 
                   15462: # See if old ID present, if so, remove
                   15463: 
1.1062    raeburn  15464:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 15465:     my $now=time;
                   15466: 
                   15467:     if ($public) {
                   15468: 	my $max_public=100;
                   15469: 	my $oldest;
                   15470: 	my $oldest_time=0;
                   15471: 	for(my $next=1;$next<=$max_public;$next++) {
                   15472: 	    if (-e $lonids."/publicuser_$next.id") {
                   15473: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   15474: 		if ($mtime<$oldest_time || !$oldest_time) {
                   15475: 		    $oldest_time=$mtime;
                   15476: 		    $oldest=$next;
                   15477: 		}
                   15478: 	    } else {
                   15479: 		$cookie="publicuser_$next";
                   15480: 		last;
                   15481: 	    }
                   15482: 	}
                   15483: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   15484:     } else {
1.463     albertel 15485: 	# if this isn't a robot, kill any existing non-robot sessions
                   15486: 	if (!$args->{'robot'}) {
                   15487: 	    opendir(DIR,$lonids);
                   15488: 	    while ($filename=readdir(DIR)) {
                   15489: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   15490: 		    unlink($lonids.'/'.$filename);
                   15491: 		}
1.462     albertel 15492: 	    }
1.463     albertel 15493: 	    closedir(DIR);
1.1204    raeburn  15494: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   15495:             my $namespace = 'nohist_courseeditor';
                   15496:             my $lockingkey = 'paste'."\0".'locked_num';
                   15497:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   15498:                                                 $domain,$username);
                   15499:             if (exists($lockhash{$lockingkey})) {
                   15500:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   15501:                 unless ($delresult eq 'ok') {
                   15502:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   15503:                 }
                   15504:             }
1.462     albertel 15505: 	}
                   15506: # Give them a new cookie
1.463     albertel 15507: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      15508: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 15509: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 15510:     
                   15511: # Initialize roles
                   15512: 
1.1062    raeburn  15513: 	($userroles,$firstaccenv,$timerintenv) = 
                   15514:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 15515:     }
                   15516: # ------------------------------------ Check browser type and MathML capability
                   15517: 
1.1194    raeburn  15518:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   15519:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 15520: 
                   15521: # ------------------------------------------------------------- Get environment
                   15522: 
                   15523:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   15524:     my ($tmp) = keys(%userenv);
                   15525:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   15526:     } else {
                   15527: 	undef(%userenv);
                   15528:     }
                   15529:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   15530: 	$form->{'interface'}=$userenv{'interface'};
                   15531:     }
                   15532:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   15533: 
                   15534: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   15535:     foreach my $option ('interface','localpath','localres') {
                   15536:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 15537:     }
                   15538: # --------------------------------------------------------- Write first profile
                   15539: 
                   15540:     {
                   15541: 	my %initial_env = 
                   15542: 	    ("user.name"          => $username,
                   15543: 	     "user.domain"        => $domain,
                   15544: 	     "user.home"          => $authhost,
                   15545: 	     "browser.type"       => $clientbrowser,
                   15546: 	     "browser.version"    => $clientversion,
                   15547: 	     "browser.mathml"     => $clientmathml,
                   15548: 	     "browser.unicode"    => $clientunicode,
                   15549: 	     "browser.os"         => $clientos,
1.1137    raeburn  15550:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  15551:              "browser.info"       => $clientinfo,
1.1194    raeburn  15552:              "browser.osversion"  => $clientosversion,
1.462     albertel 15553: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   15554: 	     "request.course.fn"  => '',
                   15555: 	     "request.course.uri" => '',
                   15556: 	     "request.course.sec" => '',
                   15557: 	     "request.role"       => 'cm',
                   15558: 	     "request.role.adv"   => $env{'user.adv'},
                   15559: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   15560: 
                   15561:         if ($form->{'localpath'}) {
                   15562: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   15563: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   15564:         }
                   15565: 	
                   15566: 	if ($form->{'interface'}) {
                   15567: 	    $form->{'interface'}=~s/\W//gs;
                   15568: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   15569: 	    $env{'browser.interface'}=$form->{'interface'};
                   15570: 	}
                   15571: 
1.1157    raeburn  15572:         if ($form->{'iptoken'}) {
                   15573:             my $lonhost = $r->dir_config('lonHostID');
                   15574:             $initial_env{"user.noloadbalance"} = $lonhost;
                   15575:             $env{'user.noloadbalance'} = $lonhost;
                   15576:         }
                   15577: 
1.981     raeburn  15578:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  15579:         my %domdef;
                   15580:         unless ($domain eq 'public') {
                   15581:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   15582:         }
1.980     raeburn  15583: 
1.1081    raeburn  15584:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  15585:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  15586:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   15587:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  15588:         }
                   15589: 
1.1237    raeburn  15590:         foreach my $crstype ('official','unofficial','community','textbook','placement') {
1.765     raeburn  15591:             $userenv{'canrequest.'.$crstype} =
                   15592:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  15593:                                                   'reload','requestcourses',
                   15594:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  15595:         }
                   15596: 
1.1092    raeburn  15597:         $userenv{'canrequest.author'} =
                   15598:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   15599:                                         'reload','requestauthor',
                   15600:                                         \%userenv,\%domdef,\%is_adv);
                   15601:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   15602:                                              $domain,$username);
                   15603:         my $reqstatus = $reqauthor{'author_status'};
                   15604:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   15605:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   15606:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   15607:                                                   $reqauthor{'author'}{'timestamp'};
                   15608:             }
                   15609:         }
                   15610: 
1.462     albertel 15611: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  15612: 
1.462     albertel 15613: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   15614: 		 &GDBM_WRCREAT(),0640)) {
                   15615: 	    &_add_to_env(\%disk_env,\%initial_env);
                   15616: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   15617: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  15618:             if (ref($firstaccenv) eq 'HASH') {
                   15619:                 &_add_to_env(\%disk_env,$firstaccenv);
                   15620:             }
                   15621:             if (ref($timerintenv) eq 'HASH') {
                   15622:                 &_add_to_env(\%disk_env,$timerintenv);
                   15623:             }
1.463     albertel 15624: 	    if (ref($args->{'extra_env'})) {
                   15625: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   15626: 	    }
1.462     albertel 15627: 	    untie(%disk_env);
                   15628: 	} else {
1.705     tempelho 15629: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   15630: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 15631: 	    return 'error: '.$!;
                   15632: 	}
                   15633:     }
                   15634:     $env{'request.role'}='cm';
                   15635:     $env{'request.role.adv'}=$env{'user.adv'};
                   15636:     $env{'browser.type'}=$clientbrowser;
                   15637: 
                   15638:     return $cookie;
                   15639: 
                   15640: }
                   15641: 
                   15642: sub _add_to_env {
                   15643:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  15644:     if (ref($env_data) eq 'HASH') {
                   15645:         while (my ($key,$value) = each(%$env_data)) {
                   15646: 	    $idf->{$prefix.$key} = $value;
                   15647: 	    $env{$prefix.$key}   = $value;
                   15648:         }
1.462     albertel 15649:     }
                   15650: }
                   15651: 
1.685     tempelho 15652: # --- Get the symbolic name of a problem and the url
                   15653: sub get_symb {
                   15654:     my ($request,$silent) = @_;
1.726     raeburn  15655:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 15656:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   15657:     if ($symb eq '') {
                   15658:         if (!$silent) {
1.1071    raeburn  15659:             if (ref($request)) { 
                   15660:                 $request->print("Unable to handle ambiguous references:$url:.");
                   15661:             }
1.685     tempelho 15662:             return ();
                   15663:         }
                   15664:     }
                   15665:     &Apache::lonenc::check_decrypt(\$symb);
                   15666:     return ($symb);
                   15667: }
                   15668: 
                   15669: # --------------------------------------------------------------Get annotation
                   15670: 
                   15671: sub get_annotation {
                   15672:     my ($symb,$enc) = @_;
                   15673: 
                   15674:     my $key = $symb;
                   15675:     if (!$enc) {
                   15676:         $key =
                   15677:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   15678:     }
                   15679:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   15680:     return $annotation{$key};
                   15681: }
                   15682: 
                   15683: sub clean_symb {
1.731     raeburn  15684:     my ($symb,$delete_enc) = @_;
1.685     tempelho 15685: 
                   15686:     &Apache::lonenc::check_decrypt(\$symb);
                   15687:     my $enc = $env{'request.enc'};
1.731     raeburn  15688:     if ($delete_enc) {
1.730     raeburn  15689:         delete($env{'request.enc'});
                   15690:     }
1.685     tempelho 15691: 
                   15692:     return ($symb,$enc);
                   15693: }
1.462     albertel 15694: 
1.1181    raeburn  15695: ############################################################
                   15696: ############################################################
                   15697: 
                   15698: =pod
                   15699: 
                   15700: =head1 Routines for building display used to search for courses
                   15701: 
                   15702: 
                   15703: =over 4
                   15704: 
                   15705: =item * &build_filters()
                   15706: 
                   15707: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  15708: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   15709: and quotacheck.pl
                   15710: 
1.1181    raeburn  15711: 
                   15712: Inputs:
                   15713: 
                   15714: filterlist - anonymous array of fields to include as potential filters 
                   15715: 
                   15716: crstype - course type
                   15717: 
                   15718: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   15719:               to pop-open a course selector (will contain "extra element"). 
                   15720: 
                   15721: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   15722: 
                   15723: filter - anonymous hash of criteria and their values
                   15724: 
                   15725: action - form action
                   15726: 
                   15727: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   15728: 
1.1182    raeburn  15729: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  15730: 
                   15731: cloneruname - username of owner of new course who wants to clone
                   15732: 
                   15733: clonerudom - domain of owner of new course who wants to clone
                   15734: 
                   15735: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   15736: 
                   15737: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   15738: 
                   15739: codedom - domain
                   15740: 
                   15741: formname - value of form element named "form". 
                   15742: 
                   15743: fixeddom - domain, if fixed.
                   15744: 
                   15745: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   15746: 
                   15747: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   15748: 
                   15749: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   15750: 
                   15751: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   15752: 
                   15753: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   15754: 
                   15755: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   15756: 
                   15757: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   15758: 
1.1182    raeburn  15759: 
1.1181    raeburn  15760: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   15761: 
1.1182    raeburn  15762: 
1.1181    raeburn  15763: Side Effects: None
                   15764: 
                   15765: =cut
                   15766: 
                   15767: # ---------------------------------------------- search for courses based on last activity etc.
                   15768: 
                   15769: sub build_filters {
                   15770:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   15771:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   15772:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   15773:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   15774:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  15775:     my ($list,$jscript);
1.1181    raeburn  15776:     my $onchange = 'javascript:updateFilters(this)';
                   15777:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   15778:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   15779:         $typeselectform,$instcodetitle);
                   15780:     if ($formname eq '') {
                   15781:         $formname = $caller;
                   15782:     }
                   15783:     foreach my $item (@{$filterlist}) {
                   15784:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   15785:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   15786:             if ($item eq 'domainfilter') {
                   15787:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   15788:             } elsif ($item eq 'coursefilter') {
                   15789:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   15790:             } elsif ($item eq 'ownerfilter') {
                   15791:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15792:             } elsif ($item eq 'ownerdomfilter') {
                   15793:                 $filter->{'ownerdomfilter'} =
                   15794:                     &LONCAPA::clean_domain($filter->{$item});
                   15795:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   15796:                                                        'ownerdomfilter',1);
                   15797:             } elsif ($item eq 'personfilter') {
                   15798:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15799:             } elsif ($item eq 'persondomfilter') {
                   15800:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   15801:                                                         'persondomfilter',1);
                   15802:             } else {
                   15803:                 $filter->{$item} =~ s/\W//g;
                   15804:             }
                   15805:             if (!$filter->{$item}) {
                   15806:                 $filter->{$item} = '';
                   15807:             }
                   15808:         }
                   15809:         if ($item eq 'domainfilter') {
                   15810:             my $allow_blank = 1;
                   15811:             if ($formname eq 'portform') {
                   15812:                 $allow_blank=0;
                   15813:             } elsif ($formname eq 'studentform') {
                   15814:                 $allow_blank=0;
                   15815:             }
                   15816:             if ($fixeddom) {
                   15817:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   15818:                                     ' value="'.$codedom.'" />'.
                   15819:                                     &Apache::lonnet::domain($codedom,'description');
                   15820:             } else {
                   15821:                 $domainselectform = &select_dom_form($filter->{$item},
                   15822:                                                      'domainfilter',
                   15823:                                                       $allow_blank,'',$onchange);
                   15824:             }
                   15825:         } else {
                   15826:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   15827:         }
                   15828:     }
                   15829: 
                   15830:     # last course activity filter and selection
                   15831:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   15832: 
                   15833:     # course created filter and selection
                   15834:     if (exists($filter->{'createdfilter'})) {
                   15835:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   15836:     }
                   15837: 
1.1239    raeburn  15838:     my $prefix = $crstype;
                   15839:     if ($crstype eq 'Placement') {
                   15840:         $prefix = 'Placement Test'
                   15841:     }
1.1181    raeburn  15842:     my %lt = &Apache::lonlocal::texthash(
1.1239    raeburn  15843:                 'cac' => "$prefix Activity",
                   15844:                 'ccr' => "$prefix Created",
                   15845:                 'cde' => "$prefix Title",
                   15846:                 'cdo' => "$prefix Domain",
1.1181    raeburn  15847:                 'ins' => 'Institutional Code',
                   15848:                 'inc' => 'Institutional Categorization',
1.1239    raeburn  15849:                 'cow' => "$prefix Owner/Co-owner",
                   15850:                 'cop' => "$prefix Personnel Includes",
1.1181    raeburn  15851:                 'cog' => 'Type',
                   15852:              );
                   15853: 
                   15854:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15855:         my $typeval = 'Course';
                   15856:         if ($crstype eq 'Community') {
                   15857:             $typeval = 'Community';
1.1239    raeburn  15858:         } elsif ($crstype eq 'Placement') {
                   15859:             $typeval = 'Placement';
1.1181    raeburn  15860:         }
                   15861:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   15862:     } else {
                   15863:         $typeselectform =  '<select name="type" size="1"';
                   15864:         if ($onchange) {
                   15865:             $typeselectform .= ' onchange="'.$onchange.'"';
                   15866:         }
                   15867:         $typeselectform .= '>'."\n";
1.1237    raeburn  15868:         foreach my $posstype ('Course','Community','Placement') {
1.1239    raeburn  15869:             my $shown;
                   15870:             if ($posstype eq 'Placement') {
                   15871:                 $shown = &mt('Placement Test');
                   15872:             } else {
                   15873:                 $shown = &mt($posstype);
                   15874:             }
1.1181    raeburn  15875:             $typeselectform.='<option value="'.$posstype.'"'.
1.1239    raeburn  15876:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181    raeburn  15877:         }
                   15878:         $typeselectform.="</select>";
                   15879:     }
                   15880: 
                   15881:     my ($cloneableonlyform,$cloneabletitle);
                   15882:     if (exists($filter->{'cloneableonly'})) {
                   15883:         my $cloneableon = '';
                   15884:         my $cloneableoff = ' checked="checked"';
                   15885:         if ($filter->{'cloneableonly'}) {
                   15886:             $cloneableon = $cloneableoff;
                   15887:             $cloneableoff = '';
                   15888:         }
                   15889:         $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>';
                   15890:         if ($formname eq 'ccrs') {
1.1187    bisitz   15891:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181    raeburn  15892:         } else {
                   15893:             $cloneabletitle = &mt('Cloneable by you');
                   15894:         }
                   15895:     }
                   15896:     my $officialjs;
                   15897:     if ($crstype eq 'Course') {
                   15898:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  15899: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   15900: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   15901:             if ($codedom) { 
1.1181    raeburn  15902:                 $officialjs = 1;
                   15903:                 ($instcodeform,$jscript,$$numtitlesref) =
                   15904:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   15905:                                                                   $officialjs,$codetitlesref);
                   15906:                 if ($jscript) {
1.1182    raeburn  15907:                     $jscript = '<script type="text/javascript">'."\n".
                   15908:                                '// <![CDATA['."\n".
                   15909:                                $jscript."\n".
                   15910:                                '// ]]>'."\n".
                   15911:                                '</script>'."\n";
1.1181    raeburn  15912:                 }
                   15913:             }
                   15914:             if ($instcodeform eq '') {
                   15915:                 $instcodeform =
                   15916:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   15917:                     $list->{'instcodefilter'}.'" />';
                   15918:                 $instcodetitle = $lt{'ins'};
                   15919:             } else {
                   15920:                 $instcodetitle = $lt{'inc'};
                   15921:             }
                   15922:             if ($fixeddom) {
                   15923:                 $instcodetitle .= '<br />('.$codedom.')';
                   15924:             }
                   15925:         }
                   15926:     }
                   15927:     my $output = qq|
                   15928: <form method="post" name="filterpicker" action="$action">
                   15929: <input type="hidden" name="form" value="$formname" />
                   15930: |;
                   15931:     if ($formname eq 'modifycourse') {
                   15932:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   15933:                    '<input type="hidden" name="prevphase" value="'.
                   15934:                    $prevphase.'" />'."\n";
1.1198    musolffc 15935:     } elsif ($formname eq 'quotacheck') {
                   15936:         $output .= qq|
                   15937: <input type="hidden" name="sortby" value="" />
                   15938: <input type="hidden" name="sortorder" value="" />
                   15939: |;
                   15940:     } else {
1.1181    raeburn  15941:         my $name_input;
                   15942:         if ($cnameelement ne '') {
                   15943:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   15944:                           $cnameelement.'" />';
                   15945:         }
                   15946:         $output .= qq|
1.1182    raeburn  15947: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   15948: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  15949: $name_input
                   15950: $roleelement
                   15951: $multelement
                   15952: $typeelement
                   15953: |;
                   15954:         if ($formname eq 'portform') {
                   15955:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   15956:         }
                   15957:     }
                   15958:     if ($fixeddom) {
                   15959:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   15960:     }
                   15961:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   15962:     if ($sincefilterform) {
                   15963:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   15964:                   .$sincefilterform
                   15965:                   .&Apache::lonhtmlcommon::row_closure();
                   15966:     }
                   15967:     if ($createdfilterform) {
                   15968:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   15969:                   .$createdfilterform
                   15970:                   .&Apache::lonhtmlcommon::row_closure();
                   15971:     }
                   15972:     if ($domainselectform) {
                   15973:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   15974:                   .$domainselectform
                   15975:                   .&Apache::lonhtmlcommon::row_closure();
                   15976:     }
                   15977:     if ($typeselectform) {
                   15978:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15979:             $output .= $typeselectform;
                   15980:         } else {
                   15981:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   15982:                       .$typeselectform
                   15983:                       .&Apache::lonhtmlcommon::row_closure();
                   15984:         }
                   15985:     }
                   15986:     if ($instcodeform) {
                   15987:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   15988:                   .$instcodeform
                   15989:                   .&Apache::lonhtmlcommon::row_closure();
                   15990:     }
                   15991:     if (exists($filter->{'ownerfilter'})) {
                   15992:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   15993:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15994:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   15995:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15996:                    $ownerdomselectform.'</td></tr></table>'.
                   15997:                    &Apache::lonhtmlcommon::row_closure();
                   15998:     }
                   15999:     if (exists($filter->{'personfilter'})) {
                   16000:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   16001:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   16002:                    '<input type="text" name="personfilter" size="20" value="'.
                   16003:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   16004:                    $persondomselectform.'</td></tr></table>'.
                   16005:                    &Apache::lonhtmlcommon::row_closure();
                   16006:     }
                   16007:     if (exists($filter->{'coursefilter'})) {
                   16008:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   16009:                   .'<input type="text" name="coursefilter" size="25" value="'
                   16010:                   .$list->{'coursefilter'}.'" />'
                   16011:                   .&Apache::lonhtmlcommon::row_closure();
                   16012:     }
                   16013:     if ($cloneableonlyform) {
                   16014:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   16015:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   16016:     }
                   16017:     if (exists($filter->{'descriptfilter'})) {
                   16018:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   16019:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   16020:                   .$list->{'descriptfilter'}.'" />'
                   16021:                   .&Apache::lonhtmlcommon::row_closure(1);
                   16022:     }
                   16023:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   16024:                '<input type="hidden" name="updater" value="" />'."\n".
                   16025:                '<input type="submit" name="gosearch" value="'.
                   16026:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   16027:     return $jscript.$clonewarning.$output;
                   16028: }
                   16029: 
                   16030: =pod 
                   16031: 
                   16032: =item * &timebased_select_form()
                   16033: 
1.1182    raeburn  16034: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  16035: filter e.g., Course Activity, Course Created, when searching for courses
                   16036: or communities
                   16037: 
                   16038: Inputs:
                   16039: 
                   16040: item - name of form element (sincefilter or createdfilter)
                   16041: 
                   16042: filter - anonymous hash of criteria and their values
                   16043: 
                   16044: Returns: HTML for a select box contained a blank, then six time selections,
                   16045:          with value set in incoming form variables currently selected. 
                   16046: 
                   16047: Side Effects: None
                   16048: 
                   16049: =cut
                   16050: 
                   16051: sub timebased_select_form {
                   16052:     my ($item,$filter) = @_;
                   16053:     if (ref($filter) eq 'HASH') {
                   16054:         $filter->{$item} =~ s/[^\d-]//g;
                   16055:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   16056:         return &select_form(
                   16057:                             $filter->{$item},
                   16058:                             $item,
                   16059:                             {      '-1' => '',
                   16060:                                 '86400' => &mt('today'),
                   16061:                                '604800' => &mt('last week'),
                   16062:                               '2592000' => &mt('last month'),
                   16063:                               '7776000' => &mt('last three months'),
                   16064:                              '15552000' => &mt('last six months'),
                   16065:                              '31104000' => &mt('last year'),
                   16066:                     'select_form_order' =>
                   16067:                            ['-1','86400','604800','2592000','7776000',
                   16068:                             '15552000','31104000']});
                   16069:     }
                   16070: }
                   16071: 
                   16072: =pod
                   16073: 
                   16074: =item * &js_changer()
                   16075: 
                   16076: Create script tag containing Javascript used to submit course search form
1.1183    raeburn  16077: when course type or domain is changed, and also to hide 'Searching ...' on
                   16078: page load completion for page showing search result.
1.1181    raeburn  16079: 
                   16080: Inputs: None
                   16081: 
1.1183    raeburn  16082: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  16083: 
                   16084: Side Effects: None
                   16085: 
                   16086: =cut
                   16087: 
                   16088: sub js_changer {
                   16089:     return <<ENDJS;
                   16090: <script type="text/javascript">
                   16091: // <![CDATA[
                   16092: function updateFilters(caller) {
                   16093:     if (typeof(caller) != "undefined") {
                   16094:         document.filterpicker.updater.value = caller.name;
                   16095:     }
                   16096:     document.filterpicker.submit();
                   16097: }
1.1183    raeburn  16098: 
                   16099: function hideSearching() {
                   16100:     if (document.getElementById('searching')) {
                   16101:         document.getElementById('searching').style.display = 'none';
                   16102:     }
                   16103:     return;
                   16104: }
                   16105: 
1.1181    raeburn  16106: // ]]>
                   16107: </script>
                   16108: 
                   16109: ENDJS
                   16110: }
                   16111: 
                   16112: =pod
                   16113: 
1.1182    raeburn  16114: =item * &search_courses()
                   16115: 
                   16116: Process selected filters form course search form and pass to lonnet::courseiddump
                   16117: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   16118: 
                   16119: Inputs:
                   16120: 
                   16121: dom - domain being searched 
                   16122: 
                   16123: type - course type ('Course' or 'Community' or '.' if any).
                   16124: 
                   16125: filter - anonymous hash of criteria and their values
                   16126: 
                   16127: numtitles - for institutional codes - number of categories
                   16128: 
                   16129: cloneruname - optional username of new course owner
                   16130: 
                   16131: clonerudom - optional domain of new course owner
                   16132: 
1.1221    raeburn  16133: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
1.1182    raeburn  16134:             (used when DC is using course creation form)
                   16135: 
                   16136: codetitles - reference to array of titles of components in institutional codes (official courses).
                   16137: 
1.1221    raeburn  16138: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   16139:            (and so can clone automatically)
                   16140: 
                   16141: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   16142: 
                   16143: reqinstcode - institutional code of new course, where search_courses is used to identify potential 
                   16144:               courses to clone 
1.1182    raeburn  16145: 
                   16146: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   16147: 
                   16148: 
                   16149: Side Effects: None
                   16150: 
                   16151: =cut
                   16152: 
                   16153: 
                   16154: sub search_courses {
1.1221    raeburn  16155:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   16156:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182    raeburn  16157:     my (%courses,%showcourses,$cloner);
                   16158:     if (($filter->{'ownerfilter'} ne '') ||
                   16159:         ($filter->{'ownerdomfilter'} ne '')) {
                   16160:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   16161:                                        $filter->{'ownerdomfilter'};
                   16162:     }
                   16163:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   16164:         if (!$filter->{$item}) {
                   16165:             $filter->{$item}='.';
                   16166:         }
                   16167:     }
                   16168:     my $now = time;
                   16169:     my $timefilter =
                   16170:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   16171:     my ($createdbefore,$createdafter);
                   16172:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   16173:         $createdbefore = $now;
                   16174:         $createdafter = $now-$filter->{'createdfilter'};
                   16175:     }
                   16176:     my ($instcodefilter,$regexpok);
                   16177:     if ($numtitles) {
                   16178:         if ($env{'form.official'} eq 'on') {
                   16179:             $instcodefilter =
                   16180:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16181:             $regexpok = 1;
                   16182:         } elsif ($env{'form.official'} eq 'off') {
                   16183:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16184:             unless ($instcodefilter eq '') {
                   16185:                 $regexpok = -1;
                   16186:             }
                   16187:         }
                   16188:     } else {
                   16189:         $instcodefilter = $filter->{'instcodefilter'};
                   16190:     }
                   16191:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   16192:     if ($type eq '') { $type = '.'; }
                   16193: 
                   16194:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   16195:         $cloner = $cloneruname.':'.$clonerudom;
                   16196:     }
                   16197:     %courses = &Apache::lonnet::courseiddump($dom,
                   16198:                                              $filter->{'descriptfilter'},
                   16199:                                              $timefilter,
                   16200:                                              $instcodefilter,
                   16201:                                              $filter->{'combownerfilter'},
                   16202:                                              $filter->{'coursefilter'},
                   16203:                                              undef,undef,$type,$regexpok,undef,undef,
1.1221    raeburn  16204:                                              undef,undef,$cloner,$cc_clone,
1.1182    raeburn  16205:                                              $filter->{'cloneableonly'},
                   16206:                                              $createdbefore,$createdafter,undef,
1.1221    raeburn  16207:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182    raeburn  16208:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   16209:         my $ccrole;
                   16210:         if ($type eq 'Community') {
                   16211:             $ccrole = 'co';
                   16212:         } else {
                   16213:             $ccrole = 'cc';
                   16214:         }
                   16215:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   16216:                                                      $filter->{'persondomfilter'},
                   16217:                                                      'userroles',undef,
                   16218:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   16219:                                                      $dom);
                   16220:         foreach my $role (keys(%rolehash)) {
                   16221:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   16222:             my $cid = $cdom.'_'.$cnum;
                   16223:             if (exists($courses{$cid})) {
                   16224:                 if (ref($courses{$cid}) eq 'HASH') {
                   16225:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   16226:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   16227:                             push (@{$courses{$cid}{roles}},$courserole);
                   16228:                         }
                   16229:                     } else {
                   16230:                         $courses{$cid}{roles} = [$courserole];
                   16231:                     }
                   16232:                     $showcourses{$cid} = $courses{$cid};
                   16233:                 }
                   16234:             }
                   16235:         }
                   16236:         %courses = %showcourses;
                   16237:     }
                   16238:     return %courses;
                   16239: }
                   16240: 
                   16241: =pod
                   16242: 
1.1181    raeburn  16243: =back
                   16244: 
1.1207    raeburn  16245: =head1 Routines for version requirements for current course.
                   16246: 
                   16247: =over 4
                   16248: 
                   16249: =item * &check_release_required()
                   16250: 
                   16251: Compares required LON-CAPA version with version on server, and
                   16252: if required version is newer looks for a server with the required version.
                   16253: 
                   16254: Looks first at servers in user's owen domain; if none suitable, looks at
                   16255: servers in course's domain are permitted to host sessions for user's domain.
                   16256: 
                   16257: Inputs:
                   16258: 
                   16259: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16260: 
                   16261: $courseid - Course ID of current course
                   16262: 
                   16263: $rolecode - User's current role in course (for switchserver query string).
                   16264: 
                   16265: $required - LON-CAPA version needed by course (format: Major.Minor).
                   16266: 
                   16267: 
                   16268: Returns:
                   16269: 
                   16270: $switchserver - query string tp append to /adm/switchserver call (if 
                   16271:                 current server's LON-CAPA version is too old. 
                   16272: 
                   16273: $warning - Message is displayed if no suitable server could be found.
                   16274: 
                   16275: =cut
                   16276: 
                   16277: sub check_release_required {
                   16278:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   16279:     my ($switchserver,$warning);
                   16280:     if ($required ne '') {
                   16281:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   16282:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16283:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   16284:             my $otherserver;
                   16285:             if (($major eq '' && $minor eq '') ||
                   16286:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   16287:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   16288:                 my $switchlcrev =
                   16289:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   16290:                                                            $userdomserver);
                   16291:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16292:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   16293:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   16294:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   16295:                     if ($cdom ne $env{'user.domain'}) {
                   16296:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   16297:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   16298:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16299:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   16300:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   16301:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   16302:                         my $canhost =
                   16303:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   16304:                                                               $coursedomserver,
                   16305:                                                               $remoterev,
                   16306:                                                               $udomdefaults{'remotesessions'},
                   16307:                                                               $defdomdefaults{'hostedsessions'});
                   16308: 
                   16309:                         if ($canhost) {
                   16310:                             $otherserver = $coursedomserver;
                   16311:                         } else {
                   16312:                             $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.");
                   16313:                         }
                   16314:                     } else {
                   16315:                         $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).");
                   16316:                     }
                   16317:                 } else {
                   16318:                     $otherserver = $userdomserver;
                   16319:                 }
                   16320:             }
                   16321:             if ($otherserver ne '') {
                   16322:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   16323:             }
                   16324:         }
                   16325:     }
                   16326:     return ($switchserver,$warning);
                   16327: }
                   16328: 
                   16329: =pod
                   16330: 
                   16331: =item * &check_release_result()
                   16332: 
                   16333: Inputs:
                   16334: 
                   16335: $switchwarning - Warning message if no suitable server found to host session.
                   16336: 
                   16337: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16338:                 and current role.
                   16339: 
                   16340: Returns: HTML to display with information about requirement to switch server.
                   16341:          Either displaying warning with link to Roles/Courses screen or
                   16342:          display link to switchserver.
                   16343: 
1.1181    raeburn  16344: =cut
                   16345: 
1.1207    raeburn  16346: sub check_release_result {
                   16347:     my ($switchwarning,$switchserver) = @_;
                   16348:     my $output = &start_page('Selected course unavailable on this server').
                   16349:                  '<p class="LC_warning">';
                   16350:     if ($switchwarning) {
                   16351:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   16352:         if (&show_course()) {
                   16353:             $output .= &mt('Display courses');
                   16354:         } else {
                   16355:             $output .= &mt('Display roles');
                   16356:         }
                   16357:         $output .= '</a>';
                   16358:     } elsif ($switchserver) {
                   16359:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   16360:                    '<br />'.
                   16361:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   16362:                    &mt('Switch Server').
                   16363:                    '</a>';
                   16364:     }
                   16365:     $output .= '</p>'.&end_page();
                   16366:     return $output;
                   16367: }
                   16368: 
                   16369: =pod
                   16370: 
                   16371: =item * &needs_coursereinit()
                   16372: 
                   16373: Determine if course contents stored for user's session needs to be
                   16374: refreshed, because content has changed since "Big Hash" last tied.
                   16375: 
                   16376: Check for change is made if time last checked is more than 10 minutes ago
                   16377: (by default).
                   16378: 
                   16379: Inputs:
                   16380: 
                   16381: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16382: 
                   16383: $interval (optional) - Time which may elapse (in s) between last check for content
                   16384:                        change in current course. (default: 600 s).  
                   16385: 
                   16386: Returns: an array; first element is:
                   16387: 
                   16388: =over 4
                   16389: 
                   16390: 'switch' - if content updates mean user's session
                   16391:            needs to be switched to a server running a newer LON-CAPA version
                   16392:  
                   16393: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   16394:            on current server hosting user's session                
                   16395: 
                   16396: ''       - if no action required.
                   16397: 
                   16398: =back
                   16399: 
                   16400: If first item element is 'switch':
                   16401: 
                   16402: second item is $switchwarning - Warning message if no suitable server found to host session. 
                   16403: 
                   16404: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16405:                               and current role. 
                   16406: 
                   16407: otherwise: no other elements returned.
                   16408: 
                   16409: =back
                   16410: 
                   16411: =cut
                   16412: 
                   16413: sub needs_coursereinit {
                   16414:     my ($loncaparev,$interval) = @_;
                   16415:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   16416:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   16417:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   16418:     my $now = time;
                   16419:     if ($interval eq '') {
                   16420:         $interval = 600;
                   16421:     }
                   16422:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   16423:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16424:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                   16425:         if ($lastchange > $env{'request.course.tied'}) {
                   16426:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16427:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   16428:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   16429:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   16430:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   16431:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   16432:                     my ($switchserver,$switchwarning) =
                   16433:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   16434:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   16435:                     if ($switchwarning ne '' || $switchserver ne '') {
                   16436:                         return ('switch',$switchwarning,$switchserver);
                   16437:                     }
                   16438:                 }
                   16439:             }
                   16440:             return ('update');
                   16441:         }
                   16442:     }
                   16443:     return ();
                   16444: }
1.1181    raeburn  16445: 
1.1083    raeburn  16446: sub update_content_constraints {
                   16447:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16448:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16449:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   16450:     my %checkresponsetypes;
                   16451:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236    raeburn  16452:         my ($item,$name,$value) = split(/:/,$key);
1.1083    raeburn  16453:         if ($item eq 'resourcetag') {
                   16454:             if ($name eq 'responsetype') {
                   16455:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   16456:             }
                   16457:         }
                   16458:     }
                   16459:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16460:     if (defined($navmap)) {
                   16461:         my %allresponses;
                   16462:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   16463:             my %responses = $res->responseTypes();
                   16464:             foreach my $key (keys(%responses)) {
                   16465:                 next unless(exists($checkresponsetypes{$key}));
                   16466:                 $allresponses{$key} += $responses{$key};
                   16467:             }
                   16468:         }
                   16469:         foreach my $key (keys(%allresponses)) {
                   16470:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   16471:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   16472:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   16473:             }
                   16474:         }
                   16475:         undef($navmap);
                   16476:     }
                   16477:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   16478:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   16479:     }
                   16480:     return;
                   16481: }
                   16482: 
1.1110    raeburn  16483: sub allmaps_incourse {
                   16484:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16485:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   16486:         $cid = $env{'request.course.id'};
                   16487:         $cdom = $env{'course.'.$cid.'.domain'};
                   16488:         $cnum = $env{'course.'.$cid.'.num'};
                   16489:         $chome = $env{'course.'.$cid.'.home'};
                   16490:     }
                   16491:     my %allmaps = ();
                   16492:     my $lastchange =
                   16493:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16494:     if ($lastchange > $env{'request.course.tied'}) {
                   16495:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   16496:         unless ($ferr) {
                   16497:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   16498:         }
                   16499:     }
                   16500:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16501:     if (defined($navmap)) {
                   16502:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   16503:             $allmaps{$res->src()} = 1;
                   16504:         }
                   16505:     }
                   16506:     return \%allmaps;
                   16507: }
                   16508: 
1.1083    raeburn  16509: sub parse_supplemental_title {
                   16510:     my ($title) = @_;
                   16511: 
                   16512:     my ($foldertitle,$renametitle);
                   16513:     if ($title =~ /&amp;&amp;&amp;/) {
                   16514:         $title = &HTML::Entites::decode($title);
                   16515:     }
                   16516:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   16517:         $renametitle=$4;
                   16518:         my ($time,$uname,$udom) = ($1,$2,$3);
                   16519:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   16520:         my $name =  &plainname($uname,$udom);
                   16521:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   16522:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   16523:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   16524:             $name.': <br />'.$foldertitle;
                   16525:     }
                   16526:     if (wantarray) {
                   16527:         return ($title,$foldertitle,$renametitle);
                   16528:     }
                   16529:     return $title;
                   16530: }
                   16531: 
1.1143    raeburn  16532: sub recurse_supplemental {
                   16533:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   16534:     if ($suppmap) {
                   16535:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   16536:         if ($fatal) {
                   16537:             $errors ++;
                   16538:         } else {
                   16539:             if ($#LONCAPA::map::resources > 0) {
                   16540:                 foreach my $res (@LONCAPA::map::resources) {
                   16541:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   16542:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  16543:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   16544:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  16545:                         } else {
                   16546:                             $numfiles ++;
                   16547:                         }
                   16548:                     }
                   16549:                 }
                   16550:             }
                   16551:         }
                   16552:     }
                   16553:     return ($numfiles,$errors);
                   16554: }
                   16555: 
1.1101    raeburn  16556: sub symb_to_docspath {
                   16557:     my ($symb) = @_;
                   16558:     return unless ($symb);
                   16559:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   16560:     if ($resurl=~/\.(sequence|page)$/) {
                   16561:         $mapurl=$resurl;
                   16562:     } elsif ($resurl eq 'adm/navmaps') {
                   16563:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   16564:     }
                   16565:     my $mapresobj;
                   16566:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16567:     if (ref($navmap)) {
                   16568:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   16569:     }
                   16570:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   16571:     my $type=$2;
                   16572:     my $path;
                   16573:     if (ref($mapresobj)) {
                   16574:         my $pcslist = $mapresobj->map_hierarchy();
                   16575:         if ($pcslist ne '') {
                   16576:             foreach my $pc (split(/,/,$pcslist)) {
                   16577:                 next if ($pc <= 1);
                   16578:                 my $res = $navmap->getByMapPc($pc);
                   16579:                 if (ref($res)) {
                   16580:                     my $thisurl = $res->src();
                   16581:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   16582:                     my $thistitle = $res->title();
                   16583:                     $path .= '&'.
                   16584:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  16585:                              &escape($thistitle).
1.1101    raeburn  16586:                              ':'.$res->randompick().
                   16587:                              ':'.$res->randomout().
                   16588:                              ':'.$res->encrypted().
                   16589:                              ':'.$res->randomorder().
                   16590:                              ':'.$res->is_page();
                   16591:                 }
                   16592:             }
                   16593:         }
                   16594:         $path =~ s/^\&//;
                   16595:         my $maptitle = $mapresobj->title();
                   16596:         if ($mapurl eq 'default') {
1.1129    raeburn  16597:             $maptitle = 'Main Content';
1.1101    raeburn  16598:         }
                   16599:         $path .= (($path ne '')? '&' : '').
                   16600:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16601:                  &escape($maptitle).
1.1101    raeburn  16602:                  ':'.$mapresobj->randompick().
                   16603:                  ':'.$mapresobj->randomout().
                   16604:                  ':'.$mapresobj->encrypted().
                   16605:                  ':'.$mapresobj->randomorder().
                   16606:                  ':'.$mapresobj->is_page();
                   16607:     } else {
                   16608:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   16609:         my $ispage = (($type eq 'page')? 1 : '');
                   16610:         if ($mapurl eq 'default') {
1.1129    raeburn  16611:             $maptitle = 'Main Content';
1.1101    raeburn  16612:         }
                   16613:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16614:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  16615:     }
                   16616:     unless ($mapurl eq 'default') {
                   16617:         $path = 'default&'.
1.1146    raeburn  16618:                 &escape('Main Content').
1.1101    raeburn  16619:                 ':::::&'.$path;
                   16620:     }
                   16621:     return $path;
                   16622: }
                   16623: 
1.1094    raeburn  16624: sub captcha_display {
                   16625:     my ($context,$lonhost) = @_;
                   16626:     my ($output,$error);
1.1234    raeburn  16627:     my ($captcha,$pubkey,$privkey,$version) = 
                   16628:         &get_captcha_config($context,$lonhost);
1.1095    raeburn  16629:     if ($captcha eq 'original') {
1.1094    raeburn  16630:         $output = &create_captcha();
                   16631:         unless ($output) {
1.1172    raeburn  16632:             $error = 'captcha';
1.1094    raeburn  16633:         }
                   16634:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  16635:         $output = &create_recaptcha($pubkey,$version);
1.1094    raeburn  16636:         unless ($output) {
1.1172    raeburn  16637:             $error = 'recaptcha';
1.1094    raeburn  16638:         }
                   16639:     }
1.1234    raeburn  16640:     return ($output,$error,$captcha,$version);
1.1094    raeburn  16641: }
                   16642: 
                   16643: sub captcha_response {
                   16644:     my ($context,$lonhost) = @_;
                   16645:     my ($captcha_chk,$captcha_error);
1.1234    raeburn  16646:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  16647:     if ($captcha eq 'original') {
1.1094    raeburn  16648:         ($captcha_chk,$captcha_error) = &check_captcha();
                   16649:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  16650:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1094    raeburn  16651:     } else {
                   16652:         $captcha_chk = 1;
                   16653:     }
                   16654:     return ($captcha_chk,$captcha_error);
                   16655: }
                   16656: 
                   16657: sub get_captcha_config {
                   16658:     my ($context,$lonhost) = @_;
1.1234    raeburn  16659:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094    raeburn  16660:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   16661:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   16662:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  16663:     if ($context eq 'usercreation') {
                   16664:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   16665:         if (ref($domconfig{$context}) eq 'HASH') {
                   16666:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   16667:             if (ref($hashtocheck) eq 'HASH') {
                   16668:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   16669:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   16670:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   16671:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   16672:                     }
                   16673:                     if ($privkey && $pubkey) {
                   16674:                         $captcha = 'recaptcha';
1.1234    raeburn  16675:                         $version = $hashtocheck->{'recaptchaversion'};
                   16676:                         if ($version ne '2') {
                   16677:                             $version = 1;
                   16678:                         }
1.1095    raeburn  16679:                     } else {
                   16680:                         $captcha = 'original';
                   16681:                     }
                   16682:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   16683:                     $captcha = 'original';
                   16684:                 }
1.1094    raeburn  16685:             }
1.1095    raeburn  16686:         } else {
                   16687:             $captcha = 'captcha';
                   16688:         }
                   16689:     } elsif ($context eq 'login') {
                   16690:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   16691:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   16692:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   16693:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  16694:             if ($privkey && $pubkey) {
                   16695:                 $captcha = 'recaptcha';
1.1234    raeburn  16696:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   16697:                 if ($version ne '2') {
                   16698:                     $version = 1; 
                   16699:                 }
1.1095    raeburn  16700:             } else {
                   16701:                 $captcha = 'original';
1.1094    raeburn  16702:             }
1.1095    raeburn  16703:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   16704:             $captcha = 'original';
1.1094    raeburn  16705:         }
                   16706:     }
1.1234    raeburn  16707:     return ($captcha,$pubkey,$privkey,$version);
1.1094    raeburn  16708: }
                   16709: 
                   16710: sub create_captcha {
                   16711:     my %captcha_params = &captcha_settings();
                   16712:     my ($output,$maxtries,$tries) = ('',10,0);
                   16713:     while ($tries < $maxtries) {
                   16714:         $tries ++;
                   16715:         my $captcha = Authen::Captcha->new (
                   16716:                                            output_folder => $captcha_params{'output_dir'},
                   16717:                                            data_folder   => $captcha_params{'db_dir'},
                   16718:                                           );
                   16719:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   16720: 
                   16721:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   16722:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   16723:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1176    raeburn  16724:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   16725:                       '<br />'.
                   16726:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  16727:             last;
                   16728:         }
                   16729:     }
                   16730:     return $output;
                   16731: }
                   16732: 
                   16733: sub captcha_settings {
                   16734:     my %captcha_params = (
                   16735:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   16736:                            www_output_dir => "/captchaspool",
                   16737:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   16738:                            numchars       => '5',
                   16739:                          );
                   16740:     return %captcha_params;
                   16741: }
                   16742: 
                   16743: sub check_captcha {
                   16744:     my ($captcha_chk,$captcha_error);
                   16745:     my $code = $env{'form.code'};
                   16746:     my $md5sum = $env{'form.crypt'};
                   16747:     my %captcha_params = &captcha_settings();
                   16748:     my $captcha = Authen::Captcha->new(
                   16749:                       output_folder => $captcha_params{'output_dir'},
                   16750:                       data_folder   => $captcha_params{'db_dir'},
                   16751:                   );
1.1109    raeburn  16752:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  16753:     my %captcha_hash = (
                   16754:                         0       => 'Code not checked (file error)',
                   16755:                        -1      => 'Failed: code expired',
                   16756:                        -2      => 'Failed: invalid code (not in database)',
                   16757:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   16758:     );
                   16759:     if ($captcha_chk != 1) {
                   16760:         $captcha_error = $captcha_hash{$captcha_chk}
                   16761:     }
                   16762:     return ($captcha_chk,$captcha_error);
                   16763: }
                   16764: 
                   16765: sub create_recaptcha {
1.1234    raeburn  16766:     my ($pubkey,$version) = @_;
                   16767:     if ($version >= 2) {
                   16768:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
                   16769:     } else {
                   16770:         my $use_ssl;
                   16771:         if ($ENV{'SERVER_PORT'} == 443) {
                   16772:             $use_ssl = 1;
                   16773:         }
                   16774:         my $captcha = Captcha::reCAPTCHA->new;
                   16775:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   16776:                $captcha->get_html($pubkey,undef,$use_ssl).
                   16777:                &mt('If the text is hard to read, [_1] will replace them.',
                   16778:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   16779:                '<br /><br />';
                   16780:     }
1.1094    raeburn  16781: }
                   16782: 
                   16783: sub check_recaptcha {
1.1234    raeburn  16784:     my ($privkey,$version) = @_;
1.1094    raeburn  16785:     my $captcha_chk;
1.1234    raeburn  16786:     if ($version >= 2) {
                   16787:         my $ua = LWP::UserAgent->new;
                   16788:         $ua->timeout(10);
                   16789:         my %info = (
                   16790:                      secret   => $privkey, 
                   16791:                      response => $env{'form.g-recaptcha-response'},
                   16792:                      remoteip => $ENV{'REMOTE_ADDR'},
                   16793:                    );
                   16794:         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
                   16795:         if ($response->is_success)  {
                   16796:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   16797:             if (ref($data) eq 'HASH') {
                   16798:                 if ($data->{'success'}) {
                   16799:                     $captcha_chk = 1;
                   16800:                 }
                   16801:             }
                   16802:         }
                   16803:     } else {
                   16804:         my $captcha = Captcha::reCAPTCHA->new;
                   16805:         my $captcha_result =
                   16806:             $captcha->check_answer(
                   16807:                                     $privkey,
                   16808:                                     $ENV{'REMOTE_ADDR'},
                   16809:                                     $env{'form.recaptcha_challenge_field'},
                   16810:                                     $env{'form.recaptcha_response_field'},
                   16811:                                   );
                   16812:         if ($captcha_result->{is_valid}) {
                   16813:             $captcha_chk = 1;
                   16814:         }
1.1094    raeburn  16815:     }
                   16816:     return $captcha_chk;
                   16817: }
                   16818: 
1.1174    raeburn  16819: sub emailusername_info {
1.1244    raeburn  16820:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174    raeburn  16821:     my %titles = &Apache::lonlocal::texthash (
                   16822:                      lastname      => 'Last Name',
                   16823:                      firstname     => 'First Name',
                   16824:                      institution   => 'School/college/university',
                   16825:                      location      => "School's city, state/province, country",
                   16826:                      web           => "School's web address",
                   16827:                      officialemail => 'E-mail address at institution (if different)',
1.1244    raeburn  16828:                      id            => 'Student/Employee ID',
1.1174    raeburn  16829:                  );
                   16830:     return (\@fields,\%titles);
                   16831: }
                   16832: 
1.1161    raeburn  16833: sub cleanup_html {
                   16834:     my ($incoming) = @_;
                   16835:     my $outgoing;
                   16836:     if ($incoming ne '') {
                   16837:         $outgoing = $incoming;
                   16838:         $outgoing =~ s/;/&#059;/g;
                   16839:         $outgoing =~ s/\#/&#035;/g;
                   16840:         $outgoing =~ s/\&/&#038;/g;
                   16841:         $outgoing =~ s/</&#060;/g;
                   16842:         $outgoing =~ s/>/&#062;/g;
                   16843:         $outgoing =~ s/\(/&#040/g;
                   16844:         $outgoing =~ s/\)/&#041;/g;
                   16845:         $outgoing =~ s/"/&#034;/g;
                   16846:         $outgoing =~ s/'/&#039;/g;
                   16847:         $outgoing =~ s/\$/&#036;/g;
                   16848:         $outgoing =~ s{/}{&#047;}g;
                   16849:         $outgoing =~ s/=/&#061;/g;
                   16850:         $outgoing =~ s/\\/&#092;/g
                   16851:     }
                   16852:     return $outgoing;
                   16853: }
                   16854: 
1.1190    musolffc 16855: # Checks for critical messages and returns a redirect url if one exists.
                   16856: # $interval indicates how often to check for messages.
                   16857: sub critical_redirect {
                   16858:     my ($interval) = @_;
                   16859:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   16860:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                   16861:                                         $env{'user.name'});
                   16862:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191    raeburn  16863:         my $redirecturl;
1.1190    musolffc 16864:         if ($what[0]) {
                   16865: 	    if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   16866: 	        $redirecturl='/adm/email?critical=display';
1.1191    raeburn  16867: 	        my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   16868:                 return (1, $url);
1.1190    musolffc 16869:             }
1.1191    raeburn  16870:         }
                   16871:     } 
                   16872:     return ();
1.1190    musolffc 16873: }
                   16874: 
1.1174    raeburn  16875: # Use:
                   16876: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   16877: #
                   16878: ##################################################
                   16879: #          password associated functions         #
                   16880: ##################################################
                   16881: sub des_keys {
                   16882:     # Make a new key for DES encryption.
                   16883:     # Each key has two parts which are returned separately.
                   16884:     # Please note:  Each key must be passed through the &hex function
                   16885:     # before it is output to the web browser.  The hex versions cannot
                   16886:     # be used to decrypt.
                   16887:     my @hexstr=('0','1','2','3','4','5','6','7',
                   16888:                 '8','9','a','b','c','d','e','f');
                   16889:     my $lkey='';
                   16890:     for (0..7) {
                   16891:         $lkey.=$hexstr[rand(15)];
                   16892:     }
                   16893:     my $ukey='';
                   16894:     for (0..7) {
                   16895:         $ukey.=$hexstr[rand(15)];
                   16896:     }
                   16897:     return ($lkey,$ukey);
                   16898: }
                   16899: 
                   16900: sub des_decrypt {
                   16901:     my ($key,$cyphertext) = @_;
                   16902:     my $keybin=pack("H16",$key);
                   16903:     my $cypher;
                   16904:     if ($Crypt::DES::VERSION>=2.03) {
                   16905:         $cypher=new Crypt::DES $keybin;
                   16906:     } else {
                   16907:         $cypher=new DES $keybin;
                   16908:     }
1.1233    raeburn  16909:     my $plaintext='';
                   16910:     my $cypherlength = length($cyphertext);
                   16911:     my $numchunks = int($cypherlength/32);
                   16912:     for (my $j=0; $j<$numchunks; $j++) {
                   16913:         my $start = $j*32;
                   16914:         my $cypherblock = substr($cyphertext,$start,32);
                   16915:         my $chunk =
                   16916:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   16917:         $chunk .=
                   16918:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   16919:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   16920:         $plaintext .= $chunk;
                   16921:     }
1.1174    raeburn  16922:     return $plaintext;
                   16923: }
                   16924: 
1.112     bowersj2 16925: 1;
                   16926: __END__;
1.41      ng       16927: 

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