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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1243  ! raeburn     4: # $Id: loncommon.pm,v 1.1242 2016/05/03 22:33:52 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.41      ng       1097: =back 
                   1098: 
1.36      matthew  1099: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1100: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1101: values for the first select menu.  The text that coincides with the 
1.41      ng       1102: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1103: and text for the second menu are given in the hash pointed to by 
                   1104: $menu{$choice1}->{'select2'}.  
                   1105: 
1.112     bowersj2 1106:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1107:                        default => "B3",
                   1108:                        select2 => { 
                   1109:                            B1 => "Choice B1",
                   1110:                            B2 => "Choice B2",
                   1111:                            B3 => "Choice B3",
                   1112:                            B4 => "Choice B4"
1.609     raeburn  1113:                            },
                   1114:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1115:                    },
                   1116:                A2 => { text =>"Choice A2" ,
                   1117:                        default => "C2",
                   1118:                        select2 => { 
                   1119:                            C1 => "Choice C1",
                   1120:                            C2 => "Choice C2",
                   1121:                            C3 => "Choice C3"
1.609     raeburn  1122:                            },
                   1123:                        order => ['C2','C1','C3'],
1.112     bowersj2 1124:                    },
                   1125:                A3 => { text =>"Choice A3" ,
                   1126:                        default => "D6",
                   1127:                        select2 => { 
                   1128:                            D1 => "Choice D1",
                   1129:                            D2 => "Choice D2",
                   1130:                            D3 => "Choice D3",
                   1131:                            D4 => "Choice D4",
                   1132:                            D5 => "Choice D5",
                   1133:                            D6 => "Choice D6",
                   1134:                            D7 => "Choice D7"
1.609     raeburn  1135:                            },
                   1136:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1137:                    }
                   1138:                );
1.36      matthew  1139: 
                   1140: =cut
                   1141: 
                   1142: sub linked_select_forms {
                   1143:     my ($formname,
                   1144:         $middletext,
                   1145:         $firstdefault,
                   1146:         $firstselectname,
                   1147:         $secondselectname, 
1.609     raeburn  1148:         $hashref,
                   1149:         $menuorder,
1.1115    raeburn  1150:         $onchangefirst,
                   1151:         $onchangesecond
1.36      matthew  1152:         ) = @_;
                   1153:     my $second = "document.$formname.$secondselectname";
                   1154:     my $first = "document.$formname.$firstselectname";
                   1155:     # output the javascript to do the changing
                   1156:     my $result = '';
1.776     bisitz   1157:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1158:     $result.="// <![CDATA[\n";
1.36      matthew  1159:     $result.="var select2data = new Object();\n";
                   1160:     $" = '","';
                   1161:     my $debug = '';
                   1162:     foreach my $s1 (sort(keys(%$hashref))) {
                   1163:         $result.="select2data.d_$s1 = new Object();\n";        
                   1164:         $result.="select2data.d_$s1.def = new String('".
                   1165:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1166:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1167:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1168:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1169:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1170:         }
1.36      matthew  1171:         $result.="\"@s2values\");\n";
                   1172:         $result.="select2data.d_$s1.texts = new Array(";        
                   1173:         my @s2texts;
                   1174:         foreach my $value (@s2values) {
                   1175:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1176:         }
                   1177:         $result.="\"@s2texts\");\n";
                   1178:     }
                   1179:     $"=' ';
                   1180:     $result.= <<"END";
                   1181: 
                   1182: function select1_changed() {
                   1183:     // Determine new choice
                   1184:     var newvalue = "d_" + $first.value;
                   1185:     // update select2
                   1186:     var values     = select2data[newvalue].values;
                   1187:     var texts      = select2data[newvalue].texts;
                   1188:     var select2def = select2data[newvalue].def;
                   1189:     var i;
                   1190:     // out with the old
                   1191:     for (i = 0; i < $second.options.length; i++) {
                   1192:         $second.options[i] = null;
                   1193:     }
                   1194:     // in with the nuclear
                   1195:     for (i=0;i<values.length; i++) {
                   1196:         $second.options[i] = new Option(values[i]);
1.143     matthew  1197:         $second.options[i].value = values[i];
1.36      matthew  1198:         $second.options[i].text = texts[i];
                   1199:         if (values[i] == select2def) {
                   1200:             $second.options[i].selected = true;
                   1201:         }
                   1202:     }
                   1203: }
1.824     bisitz   1204: // ]]>
1.36      matthew  1205: </script>
                   1206: END
                   1207:     # output the initial values for the selection lists
1.1115    raeburn  1208:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1209:     my @order = sort(keys(%{$hashref}));
                   1210:     if (ref($menuorder) eq 'ARRAY') {
                   1211:         @order = @{$menuorder};
                   1212:     }
                   1213:     foreach my $value (@order) {
1.36      matthew  1214:         $result.="    <option value=\"$value\" ";
1.253     albertel 1215:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1216:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1217:     }
                   1218:     $result .= "</select>\n";
                   1219:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1220:     $result .= $middletext;
1.1115    raeburn  1221:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1222:     if ($onchangesecond) {
                   1223:         $result .= ' onchange="'.$onchangesecond.'"';
                   1224:     }
                   1225:     $result .= ">\n";
1.36      matthew  1226:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1227:     
                   1228:     my @secondorder = sort(keys(%select2));
                   1229:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1230:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1231:     }
                   1232:     foreach my $value (@secondorder) {
1.36      matthew  1233:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1234:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1235:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1236:     }
                   1237:     $result .= "</select>\n";
                   1238:     #    return $debug;
                   1239:     return $result;
                   1240: }   #  end of sub linked_select_forms {
                   1241: 
1.45      matthew  1242: =pod
1.44      bowersj2 1243: 
1.973     raeburn  1244: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1245: 
1.112     bowersj2 1246: Returns a string corresponding to an HTML link to the given help
                   1247: $topic, where $topic corresponds to the name of a .tex file in
                   1248: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1249: spaces. 
                   1250: 
                   1251: $text will optionally be linked to the same topic, allowing you to
                   1252: link text in addition to the graphic. If you do not want to link
                   1253: text, but wish to specify one of the later parameters, pass an
                   1254: empty string. 
                   1255: 
                   1256: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1257: the link will not open a new window. If false, the link will open
                   1258: a new window using Javascript. (Default is false.) 
                   1259: 
                   1260: $width and $height are optional numerical parameters that will
                   1261: override the width and height of the popped up window, which may
1.973     raeburn  1262: be useful for certain help topics with big pictures included.
                   1263: 
                   1264: $imgid is the id of the img tag used for the help icon. This may be
                   1265: used in a javascript call to switch the image src.  See 
                   1266: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1267: 
                   1268: =cut
                   1269: 
                   1270: sub help_open_topic {
1.973     raeburn  1271:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1272:     $text = "" if (not defined $text);
1.44      bowersj2 1273:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1274:     $width = 500 if (not defined $width);
1.44      bowersj2 1275:     $height = 400 if (not defined $height);
                   1276:     my $filename = $topic;
                   1277:     $filename =~ s/ /_/g;
                   1278: 
1.48      bowersj2 1279:     my $template = "";
                   1280:     my $link;
1.572     banghart 1281:     
1.159     www      1282:     $topic=~s/\W/\_/g;
1.44      bowersj2 1283: 
1.572     banghart 1284:     if (!$stayOnPage) {
1.1033    www      1285: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1286:     } elsif ($stayOnPage eq 'popup') {
                   1287:         $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 1288:     } else {
1.48      bowersj2 1289: 	$link = "/adm/help/${filename}.hlp";
                   1290:     }
                   1291: 
                   1292:     # Add the text
1.755     neumanie 1293:     if ($text ne "") {	
1.763     bisitz   1294: 	$template.='<span class="LC_help_open_topic">'
                   1295:                   .'<a target="_top" href="'.$link.'">'
                   1296:                   .$text.'</a>';
1.48      bowersj2 1297:     }
                   1298: 
1.763     bisitz   1299:     # (Always) Add the graphic
1.179     matthew  1300:     my $title = &mt('Online Help');
1.667     raeburn  1301:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1302:     if ($imgid ne '') {
                   1303:         $imgid = ' id="'.$imgid.'"';
                   1304:     }
1.763     bisitz   1305:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1306:               .'<img src="'.$helpicon.'" border="0"'
                   1307:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1308:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1309:               .' /></a>';
                   1310:     if ($text ne "") {	
                   1311:         $template.='</span>';
                   1312:     }
1.44      bowersj2 1313:     return $template;
                   1314: 
1.106     bowersj2 1315: }
                   1316: 
                   1317: # This is a quicky function for Latex cheatsheet editing, since it 
                   1318: # appears in at least four places
                   1319: sub helpLatexCheatsheet {
1.1037    www      1320:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1321:     my $out;
1.106     bowersj2 1322:     my $addOther = '';
1.732     raeburn  1323:     if ($topic) {
1.1037    www      1324: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1325:     }
                   1326:     $out = '<span>' # Start cheatsheet
                   1327: 	  .$addOther
                   1328:           .'<span>'
1.1037    www      1329: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1330: 	  .'</span> <span>'
1.1037    www      1331: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1332: 	  .'</span>';
1.732     raeburn  1333:     unless ($not_author) {
1.1186    kruse    1334:         $out .= '<span>'
                   1335:                .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                   1336:                .'</span> <span>'
                   1337:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763     bisitz   1338: 	       .'</span>';
1.732     raeburn  1339:     }
1.763     bisitz   1340:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1341:     return $out;
1.172     www      1342: }
                   1343: 
1.430     albertel 1344: sub general_help {
                   1345:     my $helptopic='Student_Intro';
                   1346:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1347: 	$helptopic='Authoring_Intro';
1.907     raeburn  1348:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1349: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1350:     } elsif ($env{'request.role'}=~/^dc/) {
                   1351:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1352:     }
                   1353:     return $helptopic;
                   1354: }
                   1355: 
                   1356: sub update_help_link {
                   1357:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1358:     my $origurl = $ENV{'REQUEST_URI'};
                   1359:     $origurl=~s|^/~|/priv/|;
                   1360:     my $timestamp = time;
                   1361:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1362:         $$datum = &escape($$datum);
                   1363:     }
                   1364: 
                   1365:     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";
                   1366:     my $output .= <<"ENDOUTPUT";
                   1367: <script type="text/javascript">
1.824     bisitz   1368: // <![CDATA[
1.430     albertel 1369: banner_link = '$banner_link';
1.824     bisitz   1370: // ]]>
1.430     albertel 1371: </script>
                   1372: ENDOUTPUT
                   1373:     return $output;
                   1374: }
                   1375: 
                   1376: # now just updates the help link and generates a blue icon
1.193     raeburn  1377: sub help_open_menu {
1.430     albertel 1378:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1379: 	= @_;    
1.949     droeschl 1380:     $stayOnPage = 1;
1.430     albertel 1381:     my $output;
                   1382:     if ($component_help) {
                   1383: 	if (!$text) {
                   1384: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1385: 				       $width,$height);
                   1386: 	} else {
                   1387: 	    my $help_text;
                   1388: 	    $help_text=&unescape($topic);
                   1389: 	    $output='<table><tr><td>'.
                   1390: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1391: 				 $width,$height).'</td></tr></table>';
                   1392: 	}
                   1393:     }
                   1394:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1395:     return $output.$banner_link;
                   1396: }
                   1397: 
                   1398: sub top_nav_help {
                   1399:     my ($text) = @_;
1.436     albertel 1400:     $text = &mt($text);
1.949     droeschl 1401:     my $stay_on_page = 1;
                   1402: 
1.1168    raeburn  1403:     my ($link,$banner_link);
                   1404:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1405:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1406: 	                         : "javascript:helpMenu('open')";
                   1407:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1408:     }
1.201     raeburn  1409:     my $title = &mt('Get help');
1.1168    raeburn  1410:     if ($link) {
                   1411:         return <<"END";
1.436     albertel 1412: $banner_link
1.1159    raeburn  1413: <a href="$link" title="$title">$text</a>
1.436     albertel 1414: END
1.1168    raeburn  1415:     } else {
                   1416:         return '&nbsp;'.$text.'&nbsp;';
                   1417:     }
1.436     albertel 1418: }
                   1419: 
                   1420: sub help_menu_js {
1.1154    raeburn  1421:     my ($httphost) = @_;
1.949     droeschl 1422:     my $stayOnPage = 1;
1.436     albertel 1423:     my $width = 620;
                   1424:     my $height = 600;
1.430     albertel 1425:     my $helptopic=&general_help();
1.1154    raeburn  1426:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1427:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1428:     my $start_page =
                   1429:         &Apache::loncommon::start_page('Help Menu', undef,
                   1430: 				       {'frameset'    => 1,
                   1431: 					'js_ready'    => 1,
1.1154    raeburn  1432:                                         'use_absolute' => $httphost,
1.331     albertel 1433: 					'add_entries' => {
1.1168    raeburn  1434: 					    'border' => '0', 
1.579     raeburn  1435: 					    'rows'   => "110,*",},});
1.331     albertel 1436:     my $end_page =
                   1437:         &Apache::loncommon::end_page({'frameset' => 1,
                   1438: 				      'js_ready' => 1,});
                   1439: 
1.436     albertel 1440:     my $template .= <<"ENDTEMPLATE";
                   1441: <script type="text/javascript">
1.877     bisitz   1442: // <![CDATA[
1.253     albertel 1443: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1444: var banner_link = '';
1.243     raeburn  1445: function helpMenu(target) {
                   1446:     var caller = this;
                   1447:     if (target == 'open') {
                   1448:         var newWindow = null;
                   1449:         try {
1.262     albertel 1450:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1451:         }
                   1452:         catch(error) {
                   1453:             writeHelp(caller);
                   1454:             return;
                   1455:         }
                   1456:         if (newWindow) {
                   1457:             caller = newWindow;
                   1458:         }
1.193     raeburn  1459:     }
1.243     raeburn  1460:     writeHelp(caller);
                   1461:     return;
                   1462: }
                   1463: function writeHelp(caller) {
1.1168    raeburn  1464:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1465:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1466:     caller.document.close();
                   1467:     caller.focus();
1.193     raeburn  1468: }
1.877     bisitz   1469: // END LON-CAPA Internal -->
1.253     albertel 1470: // ]]>
1.436     albertel 1471: </script>
1.193     raeburn  1472: ENDTEMPLATE
                   1473:     return $template;
                   1474: }
                   1475: 
1.172     www      1476: sub help_open_bug {
                   1477:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1478:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1479:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1480:     $text = "" if (not defined $text);
                   1481: 	$stayOnPage=1;
1.184     albertel 1482:     $width = 600 if (not defined $width);
                   1483:     $height = 600 if (not defined $height);
1.172     www      1484: 
                   1485:     $topic=~s/\W+/\+/g;
                   1486:     my $link='';
                   1487:     my $template='';
1.379     albertel 1488:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1489: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1490:     if (!$stayOnPage)
                   1491:     {
                   1492: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1493:     }
                   1494:     else
                   1495:     {
                   1496: 	$link = $url;
                   1497:     }
                   1498:     # Add the text
                   1499:     if ($text ne "")
                   1500:     {
                   1501: 	$template .= 
                   1502:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1503:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1504:     }
                   1505: 
                   1506:     # Add the graphic
1.179     matthew  1507:     my $title = &mt('Report a Bug');
1.215     albertel 1508:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1509:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1510:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1511: ENDTEMPLATE
                   1512:     if ($text ne '') { $template.='</td></tr></table>' };
                   1513:     return $template;
                   1514: 
                   1515: }
                   1516: 
                   1517: sub help_open_faq {
                   1518:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1519:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1520:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1521:     $text = "" if (not defined $text);
                   1522: 	$stayOnPage=1;
                   1523:     $width = 350 if (not defined $width);
                   1524:     $height = 400 if (not defined $height);
                   1525: 
                   1526:     $topic=~s/\W+/\+/g;
                   1527:     my $link='';
                   1528:     my $template='';
                   1529:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1530:     if (!$stayOnPage)
                   1531:     {
                   1532: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1533:     }
                   1534:     else
                   1535:     {
                   1536: 	$link = $url;
                   1537:     }
                   1538: 
                   1539:     # Add the text
                   1540:     if ($text ne "")
                   1541:     {
                   1542: 	$template .= 
1.173     www      1543:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1544:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1545:     }
                   1546: 
                   1547:     # Add the graphic
1.179     matthew  1548:     my $title = &mt('View the FAQ');
1.215     albertel 1549:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1550:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1551:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1552: ENDTEMPLATE
                   1553:     if ($text ne '') { $template.='</td></tr></table>' };
                   1554:     return $template;
                   1555: 
1.44      bowersj2 1556: }
1.37      matthew  1557: 
1.180     matthew  1558: ###############################################################
                   1559: ###############################################################
                   1560: 
1.45      matthew  1561: =pod
                   1562: 
1.648     raeburn  1563: =item * &change_content_javascript():
1.256     matthew  1564: 
                   1565: This and the next function allow you to create small sections of an
                   1566: otherwise static HTML page that you can update on the fly with
                   1567: Javascript, even in Netscape 4.
                   1568: 
                   1569: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1570: must be written to the HTML page once. It will prove the Javascript
                   1571: function "change(name, content)". Calling the change function with the
                   1572: name of the section 
                   1573: you want to update, matching the name passed to C<changable_area>, and
                   1574: the new content you want to put in there, will put the content into
                   1575: that area.
                   1576: 
                   1577: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1578: to contain room for the original contents. You need to "make space"
                   1579: for whatever changes you wish to make, and be B<sure> to check your
                   1580: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1581: it's adequate for updating a one-line status display, but little more.
                   1582: This script will set the space to 100% width, so you only need to
                   1583: worry about height in Netscape 4.
                   1584: 
                   1585: Modern browsers are much less limiting, and if you can commit to the
                   1586: user not using Netscape 4, this feature may be used freely with
                   1587: pretty much any HTML.
                   1588: 
                   1589: =cut
                   1590: 
                   1591: sub change_content_javascript {
                   1592:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1593:     if ($env{'browser.type'} eq 'netscape' &&
                   1594: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1595: 	return (<<NETSCAPE4);
                   1596: 	function change(name, content) {
                   1597: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1598: 	    doc.open();
                   1599: 	    doc.write(content);
                   1600: 	    doc.close();
                   1601: 	}
                   1602: NETSCAPE4
                   1603:     } else {
                   1604: 	# Otherwise, we need to use semi-standards-compliant code
                   1605: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1606: 	# is really scary, and every useful browser supports it
                   1607: 	return (<<DOMBASED);
                   1608: 	function change(name, content) {
                   1609: 	    element = document.getElementById(name);
                   1610: 	    element.innerHTML = content;
                   1611: 	}
                   1612: DOMBASED
                   1613:     }
                   1614: }
                   1615: 
                   1616: =pod
                   1617: 
1.648     raeburn  1618: =item * &changable_area($name,$origContent):
1.256     matthew  1619: 
                   1620: This provides a "changable area" that can be modified on the fly via
                   1621: the Javascript code provided in C<change_content_javascript>. $name is
                   1622: the name you will use to reference the area later; do not repeat the
                   1623: same name on a given HTML page more then once. $origContent is what
                   1624: the area will originally contain, which can be left blank.
                   1625: 
                   1626: =cut
                   1627: 
                   1628: sub changable_area {
                   1629:     my ($name, $origContent) = @_;
                   1630: 
1.258     albertel 1631:     if ($env{'browser.type'} eq 'netscape' &&
                   1632: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1633: 	# If this is netscape 4, we need to use the Layer tag
                   1634: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1635:     } else {
                   1636: 	return "<span id='$name'>$origContent</span>";
                   1637:     }
                   1638: }
                   1639: 
                   1640: =pod
                   1641: 
1.648     raeburn  1642: =item * &viewport_geometry_js 
1.590     raeburn  1643: 
                   1644: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1645: 
                   1646: =cut
                   1647: 
                   1648: 
                   1649: sub viewport_geometry_js { 
                   1650:     return <<"GEOMETRY";
                   1651: var Geometry = {};
                   1652: function init_geometry() {
                   1653:     if (Geometry.init) { return };
                   1654:     Geometry.init=1;
                   1655:     if (window.innerHeight) {
                   1656:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1657:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1658:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1659:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1660:     }
                   1661:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1662:         Geometry.getViewportHeight =
                   1663:             function() { return document.documentElement.clientHeight; };
                   1664:         Geometry.getViewportWidth =
                   1665:             function() { return document.documentElement.clientWidth; };
                   1666: 
                   1667:         Geometry.getHorizontalScroll =
                   1668:             function() { return document.documentElement.scrollLeft; };
                   1669:         Geometry.getVerticalScroll =
                   1670:             function() { return document.documentElement.scrollTop; };
                   1671:     }
                   1672:     else if (document.body.clientHeight) {
                   1673:         Geometry.getViewportHeight =
                   1674:             function() { return document.body.clientHeight; };
                   1675:         Geometry.getViewportWidth =
                   1676:             function() { return document.body.clientWidth; };
                   1677:         Geometry.getHorizontalScroll =
                   1678:             function() { return document.body.scrollLeft; };
                   1679:         Geometry.getVerticalScroll =
                   1680:             function() { return document.body.scrollTop; };
                   1681:     }
                   1682: }
                   1683: 
                   1684: GEOMETRY
                   1685: }
                   1686: 
                   1687: =pod
                   1688: 
1.648     raeburn  1689: =item * &viewport_size_js()
1.590     raeburn  1690: 
                   1691: 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. 
                   1692: 
                   1693: =cut
                   1694: 
                   1695: sub viewport_size_js {
                   1696:     my $geometry = &viewport_geometry_js();
                   1697:     return <<"DIMS";
                   1698: 
                   1699: $geometry
                   1700: 
                   1701: function getViewportDims(width,height) {
                   1702:     init_geometry();
                   1703:     width.value = Geometry.getViewportWidth();
                   1704:     height.value = Geometry.getViewportHeight();
                   1705:     return;
                   1706: }
                   1707: 
                   1708: DIMS
                   1709: }
                   1710: 
                   1711: =pod
                   1712: 
1.648     raeburn  1713: =item * &resize_textarea_js()
1.565     albertel 1714: 
                   1715: emits the needed javascript to resize a textarea to be as big as possible
                   1716: 
                   1717: creates a function resize_textrea that takes two IDs first should be
                   1718: the id of the element to resize, second should be the id of a div that
                   1719: surrounds everything that comes after the textarea, this routine needs
                   1720: to be attached to the <body> for the onload and onresize events.
                   1721: 
1.648     raeburn  1722: =back
1.565     albertel 1723: 
                   1724: =cut
                   1725: 
                   1726: sub resize_textarea_js {
1.590     raeburn  1727:     my $geometry = &viewport_geometry_js();
1.565     albertel 1728:     return <<"RESIZE";
                   1729:     <script type="text/javascript">
1.824     bisitz   1730: // <![CDATA[
1.590     raeburn  1731: $geometry
1.565     albertel 1732: 
1.588     albertel 1733: function getX(element) {
                   1734:     var x = 0;
                   1735:     while (element) {
                   1736: 	x += element.offsetLeft;
                   1737: 	element = element.offsetParent;
                   1738:     }
                   1739:     return x;
                   1740: }
                   1741: function getY(element) {
                   1742:     var y = 0;
                   1743:     while (element) {
                   1744: 	y += element.offsetTop;
                   1745: 	element = element.offsetParent;
                   1746:     }
                   1747:     return y;
                   1748: }
                   1749: 
                   1750: 
1.565     albertel 1751: function resize_textarea(textarea_id,bottom_id) {
                   1752:     init_geometry();
                   1753:     var textarea        = document.getElementById(textarea_id);
                   1754:     //alert(textarea);
                   1755: 
1.588     albertel 1756:     var textarea_top    = getY(textarea);
1.565     albertel 1757:     var textarea_height = textarea.offsetHeight;
                   1758:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1759:     var bottom_top      = getY(bottom);
1.565     albertel 1760:     var bottom_height   = bottom.offsetHeight;
                   1761:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1762:     var fudge           = 23;
1.565     albertel 1763:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1764:     if (new_height < 300) {
                   1765: 	new_height = 300;
                   1766:     }
                   1767:     textarea.style.height=new_height+'px';
                   1768: }
1.824     bisitz   1769: // ]]>
1.565     albertel 1770: </script>
                   1771: RESIZE
                   1772: 
                   1773: }
                   1774: 
1.1205    golterma 1775: sub colorfuleditor_js {
                   1776:     return <<"COLORFULEDIT"
                   1777: <script type="text/javascript">
                   1778: // <![CDATA[>
                   1779:     function fold_box(curDepth, lastresource){
                   1780: 
                   1781:     // we need a list because there can be several blocks you need to fold in one tag
                   1782:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1783:     // but there is only one folding button per tag
                   1784:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1785: 
                   1786:         if(block.item(0).style.display == 'none'){
                   1787: 
                   1788:             foldbutton.value = '@{[&mt("Hide")]}';
                   1789:             for (i = 0; i < block.length; i++){
                   1790:                 block.item(i).style.display = '';
                   1791:             }
                   1792:         }else{
                   1793: 
                   1794:             foldbutton.value = '@{[&mt("Show")]}';
                   1795:             for (i = 0; i < block.length; i++){
                   1796:                 // block.item(i).style.visibility = 'collapse';
                   1797:                 block.item(i).style.display = 'none';
                   1798:             }
                   1799:         };
                   1800:         saveState(lastresource);
                   1801:     }
                   1802: 
                   1803:     function saveState (lastresource) {
                   1804: 
                   1805:         var tag_list = getTagList();
                   1806:         if(tag_list != null){
                   1807:             var timestamp = new Date().getTime();
                   1808:             var key = lastresource;
                   1809: 
                   1810:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1811:             // starting with timestamp
                   1812:             var value = timestamp+';';
                   1813: 
                   1814:             // building the list of key-value pairs
                   1815:             for(var i = 0; i < tag_list.length; i++){
                   1816:                 value += tag_list[i]+',';
                   1817:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1818:             }
                   1819: 
                   1820:             // only iterate whole storage if nothing to override
                   1821:             if(localStorage.getItem(key) == null){        
                   1822: 
                   1823:                 // prevent storage from growing large
                   1824:                 if(localStorage.length > 50){
                   1825:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1826:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1827:                     var oldest_key;
                   1828:                     
                   1829:                     for(var i = 1; i < localStorage.length; i++){
                   1830:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1831:                             oldest_key = localStorage.key(i);
                   1832:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1833:                         }
                   1834:                     }
                   1835:                     localStorage.removeItem(oldest_key);
                   1836:                 }
                   1837:             }
                   1838:             localStorage.setItem(key,value);
                   1839:         }
                   1840:     }
                   1841: 
                   1842:     // restore folding status of blocks (on page load)
                   1843:     function restoreState (lastresource) {
                   1844:         if(localStorage.getItem(lastresource) != null){
                   1845:             var key = lastresource;
                   1846:             var value = localStorage.getItem(key);
                   1847:             var regex_delTimestamp = /^\d+;/;
                   1848: 
                   1849:             value.replace(regex_delTimestamp, '');
                   1850: 
                   1851:             var valueArr = value.split(';');
                   1852:             var pairs;
                   1853:             var elements;
                   1854:             for (var i = 0; i < valueArr.length; i++){
                   1855:                 pairs = valueArr[i].split(',');
                   1856:                 elements = document.getElementsByName(pairs[0]);
                   1857: 
                   1858:                 for (var j = 0; j < elements.length; j++){  
                   1859:                     elements[j].style.display = pairs[1];
                   1860:                     if (pairs[1] == "none"){
                   1861:                         var regex_id = /([_\\d]+)\$/;
                   1862:                         regex_id.exec(pairs[0]);
                   1863:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   1864:                     }
                   1865:                 }
                   1866:             }
                   1867:         }
                   1868:     }
                   1869: 
                   1870:     function getTagList () {
                   1871:         
                   1872:         var stringToSearch = document.lonhomework.innerHTML;
                   1873: 
                   1874:         var ret = new Array();
                   1875:         var regex_findBlock = /(foldblock_.*?)"/g;
                   1876:         var tag_list = stringToSearch.match(regex_findBlock);
                   1877: 
                   1878:         if(tag_list != null){
                   1879:             for(var i = 0; i < tag_list.length; i++){            
                   1880:                 ret.push(tag_list[i].replace(/"/, ''));
                   1881:             }
                   1882:         }
                   1883:         return ret;
                   1884:     }
                   1885: 
                   1886:     function saveScrollPosition (resource) {
                   1887:         var tag_list = getTagList();
                   1888: 
                   1889:         // we dont always want to jump to the first block
                   1890:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   1891:         if(\$(window).scrollTop() > 170){
                   1892:             if(tag_list != null){
                   1893:                 var result;
                   1894:                 for(var i = 0; i < tag_list.length; i++){
                   1895:                     if(isElementInViewport(tag_list[i])){
                   1896:                         result += tag_list[i]+';';
                   1897:                     }
                   1898:                 }
                   1899:                 sessionStorage.setItem('anchor_'+resource, result);
                   1900:             }
                   1901:         } else {
                   1902:             // we dont need to save zero, just delete the item to leave everything tidy
                   1903:             sessionStorage.removeItem('anchor_'+resource);
                   1904:         }
                   1905:     }
                   1906: 
                   1907:     function restoreScrollPosition(resource){
                   1908: 
                   1909:         var elem = sessionStorage.getItem('anchor_'+resource);
                   1910:         if(elem != null){
                   1911:             var tag_list = elem.split(';');
                   1912:             var elem_list;
                   1913: 
                   1914:             for(var i = 0; i < tag_list.length; i++){
                   1915:                 elem_list = document.getElementsByName(tag_list[i]);
                   1916:                 
                   1917:                 if(elem_list.length > 0){
                   1918:                     elem = elem_list[0];
                   1919:                     break;
                   1920:                 }
                   1921:             }
                   1922:             elem.scrollIntoView();
                   1923:         }
                   1924:     }
                   1925: 
                   1926:     function isElementInViewport(el) {
                   1927: 
                   1928:         // change to last element instead of first
                   1929:         var elem = document.getElementsByName(el);
                   1930:         var rect = elem[0].getBoundingClientRect();
                   1931: 
                   1932:         return (
                   1933:             rect.top >= 0 &&
                   1934:             rect.left >= 0 &&
                   1935:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   1936:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   1937:         );
                   1938:     }
                   1939:     
                   1940:     function autosize(depth){
                   1941:         var cmInst = window['cm'+depth];
                   1942:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   1943: 
                   1944:         // is fixed size, switching to dynamic
                   1945:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   1946:             cmInst.setSize("","auto");
                   1947:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   1948:             sessionStorage.setItem("autosized_"+depth, "yes");
                   1949: 
                   1950:         // is dynamic size, switching to fixed
                   1951:         } else {
                   1952:             cmInst.setSize("","300px");
                   1953:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   1954:             sessionStorage.removeItem("autosized_"+depth);
                   1955:         }
                   1956:     }
                   1957: 
                   1958: 
                   1959: 
                   1960: // ]]>
                   1961: </script>
                   1962: COLORFULEDIT
                   1963: }
                   1964: 
                   1965: sub xmleditor_js {
                   1966:     return <<XMLEDIT
                   1967: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   1968: <script type="text/javascript">
                   1969: // <![CDATA[>
                   1970: 
                   1971:     function saveScrollPosition (resource) {
                   1972: 
                   1973:         var scrollPos = \$(window).scrollTop();
                   1974:         sessionStorage.setItem(resource,scrollPos);
                   1975:     }
                   1976: 
                   1977:     function restoreScrollPosition(resource){
                   1978: 
                   1979:         var scrollPos = sessionStorage.getItem(resource);
                   1980:         \$(window).scrollTop(scrollPos);
                   1981:     }
                   1982: 
                   1983:     // unless internet explorer
                   1984:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   1985: 
                   1986:         \$(document).ready(function() {
                   1987:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   1988:         });
                   1989:     }
                   1990: 
                   1991:     // inserts text at cursor position into codemirror (xml editor only)
                   1992:     function insertText(text){
                   1993:         cm.focus();
                   1994:         var curPos = cm.getCursor();
                   1995:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   1996:     }
                   1997: // ]]>
                   1998: </script>
                   1999: XMLEDIT
                   2000: }
                   2001: 
                   2002: sub insert_folding_button {
                   2003:     my $curDepth = $Apache::lonxml::curdepth;
                   2004:     my $lastresource = $env{'request.ambiguous'};
                   2005: 
                   2006:     return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
                   2007:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2008: }
                   2009: 
1.565     albertel 2010: =pod
                   2011: 
1.256     matthew  2012: =head1 Excel and CSV file utility routines
                   2013: 
                   2014: =cut
                   2015: 
                   2016: ###############################################################
                   2017: ###############################################################
                   2018: 
                   2019: =pod
                   2020: 
1.1162    raeburn  2021: =over 4
                   2022: 
1.648     raeburn  2023: =item * &csv_translate($text) 
1.37      matthew  2024: 
1.185     www      2025: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2026: format.
                   2027: 
                   2028: =cut
                   2029: 
1.180     matthew  2030: ###############################################################
                   2031: ###############################################################
1.37      matthew  2032: sub csv_translate {
                   2033:     my $text = shift;
                   2034:     $text =~ s/\"/\"\"/g;
1.209     albertel 2035:     $text =~ s/\n/ /g;
1.37      matthew  2036:     return $text;
                   2037: }
1.180     matthew  2038: 
                   2039: ###############################################################
                   2040: ###############################################################
                   2041: 
                   2042: =pod
                   2043: 
1.648     raeburn  2044: =item * &define_excel_formats()
1.180     matthew  2045: 
                   2046: Define some commonly used Excel cell formats.
                   2047: 
                   2048: Currently supported formats:
                   2049: 
                   2050: =over 4
                   2051: 
                   2052: =item header
                   2053: 
                   2054: =item bold
                   2055: 
                   2056: =item h1
                   2057: 
                   2058: =item h2
                   2059: 
                   2060: =item h3
                   2061: 
1.256     matthew  2062: =item h4
                   2063: 
                   2064: =item i
                   2065: 
1.180     matthew  2066: =item date
                   2067: 
                   2068: =back
                   2069: 
                   2070: Inputs: $workbook
                   2071: 
                   2072: Returns: $format, a hash reference.
                   2073: 
1.1057    foxr     2074: 
1.180     matthew  2075: =cut
                   2076: 
                   2077: ###############################################################
                   2078: ###############################################################
                   2079: sub define_excel_formats {
                   2080:     my ($workbook) = @_;
                   2081:     my $format;
                   2082:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2083:                                                 bottom    => 1,
                   2084:                                                 align     => 'center');
                   2085:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2086:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2087:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2088:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2089:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2090:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2091:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2092:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2093:     return $format;
                   2094: }
                   2095: 
                   2096: ###############################################################
                   2097: ###############################################################
1.113     bowersj2 2098: 
                   2099: =pod
                   2100: 
1.648     raeburn  2101: =item * &create_workbook()
1.255     matthew  2102: 
                   2103: Create an Excel worksheet.  If it fails, output message on the
                   2104: request object and return undefs.
                   2105: 
                   2106: Inputs: Apache request object
                   2107: 
                   2108: Returns (undef) on failure, 
                   2109:     Excel worksheet object, scalar with filename, and formats 
                   2110:     from &Apache::loncommon::define_excel_formats on success
                   2111: 
                   2112: =cut
                   2113: 
                   2114: ###############################################################
                   2115: ###############################################################
                   2116: sub create_workbook {
                   2117:     my ($r) = @_;
                   2118:         #
                   2119:     # Create the excel spreadsheet
                   2120:     my $filename = '/prtspool/'.
1.258     albertel 2121:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2122:         time.'_'.rand(1000000000).'.xls';
                   2123:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2124:     if (! defined($workbook)) {
                   2125:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2126:         $r->print(
                   2127:             '<p class="LC_error">'
                   2128:            .&mt('Problems occurred in creating the new Excel file.')
                   2129:            .' '.&mt('This error has been logged.')
                   2130:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2131:            .'</p>'
                   2132:         );
1.255     matthew  2133:         return (undef);
                   2134:     }
                   2135:     #
1.1014    foxr     2136:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2137:     #
                   2138:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2139:     return ($workbook,$filename,$format);
                   2140: }
                   2141: 
                   2142: ###############################################################
                   2143: ###############################################################
                   2144: 
                   2145: =pod
                   2146: 
1.648     raeburn  2147: =item * &create_text_file()
1.113     bowersj2 2148: 
1.542     raeburn  2149: Create a file to write to and eventually make available to the user.
1.256     matthew  2150: If file creation fails, outputs an error message on the request object and 
                   2151: return undefs.
1.113     bowersj2 2152: 
1.256     matthew  2153: Inputs: Apache request object, and file suffix
1.113     bowersj2 2154: 
1.256     matthew  2155: Returns (undef) on failure, 
                   2156:     Filehandle and filename on success.
1.113     bowersj2 2157: 
                   2158: =cut
                   2159: 
1.256     matthew  2160: ###############################################################
                   2161: ###############################################################
                   2162: sub create_text_file {
                   2163:     my ($r,$suffix) = @_;
                   2164:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2165:     my $fh;
                   2166:     my $filename = '/prtspool/'.
1.258     albertel 2167:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2168:         time.'_'.rand(1000000000).'.'.$suffix;
                   2169:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2170:     if (! defined($fh)) {
                   2171:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2172:         $r->print(
                   2173:             '<p class="LC_error">'
                   2174:            .&mt('Problems occurred in creating the output file.')
                   2175:            .' '.&mt('This error has been logged.')
                   2176:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2177:            .'</p>'
                   2178:         );
1.113     bowersj2 2179:     }
1.256     matthew  2180:     return ($fh,$filename)
1.113     bowersj2 2181: }
                   2182: 
                   2183: 
1.256     matthew  2184: =pod 
1.113     bowersj2 2185: 
                   2186: =back
                   2187: 
                   2188: =cut
1.37      matthew  2189: 
                   2190: ###############################################################
1.33      matthew  2191: ##        Home server <option> list generating code          ##
                   2192: ###############################################################
1.35      matthew  2193: 
1.169     www      2194: # ------------------------------------------
                   2195: 
                   2196: sub domain_select {
                   2197:     my ($name,$value,$multiple)=@_;
                   2198:     my %domains=map { 
1.514     albertel 2199: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 2200:     } &Apache::lonnet::all_domains();
1.169     www      2201:     if ($multiple) {
                   2202: 	$domains{''}=&mt('Any domain');
1.550     albertel 2203: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2204: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2205:     } else {
1.550     albertel 2206: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2207: 	return &select_form($name,$value,\%domains);
1.169     www      2208:     }
                   2209: }
                   2210: 
1.282     albertel 2211: #-------------------------------------------
                   2212: 
                   2213: =pod
                   2214: 
1.519     raeburn  2215: =head1 Routines for form select boxes
                   2216: 
                   2217: =over 4
                   2218: 
1.648     raeburn  2219: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2220: 
                   2221: Returns a string containing a <select> element int multiple mode
                   2222: 
                   2223: 
                   2224: Args:
                   2225:   $name - name of the <select> element
1.506     raeburn  2226:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2227:   $size - number of rows long the select element is
1.283     albertel 2228:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2229:           (shown text should already have been &mt())
1.506     raeburn  2230:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2231: 
1.282     albertel 2232: =cut
                   2233: 
                   2234: #-------------------------------------------
1.169     www      2235: sub multiple_select_form {
1.284     albertel 2236:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2237:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2238:     my $output='';
1.191     matthew  2239:     if (! defined($size)) {
                   2240:         $size = 4;
1.283     albertel 2241:         if (scalar(keys(%$hash))<4) {
                   2242:             $size = scalar(keys(%$hash));
1.191     matthew  2243:         }
                   2244:     }
1.734     bisitz   2245:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2246:     my @order;
1.506     raeburn  2247:     if (ref($order) eq 'ARRAY')  {
                   2248:         @order = @{$order};
                   2249:     } else {
                   2250:         @order = sort(keys(%$hash));
1.501     banghart 2251:     }
                   2252:     if (exists($$hash{'select_form_order'})) {
                   2253:         @order = @{$$hash{'select_form_order'}};
                   2254:     }
                   2255:         
1.284     albertel 2256:     foreach my $key (@order) {
1.356     albertel 2257:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2258:         $output.='selected="selected" ' if ($selected{$key});
                   2259:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2260:     }
                   2261:     $output.="</select>\n";
                   2262:     return $output;
                   2263: }
                   2264: 
1.88      www      2265: #-------------------------------------------
                   2266: 
                   2267: =pod
                   2268: 
1.970     raeburn  2269: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2270: 
                   2271: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2272: allow a user to select options from a ref to a hash containing:
                   2273: option_name => displayed text. An optional $onchange can include
                   2274: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2275: 
1.88      www      2276: See lonrights.pm for an example invocation and use.
                   2277: 
                   2278: =cut
                   2279: 
                   2280: #-------------------------------------------
                   2281: sub select_form {
1.1228    raeburn  2282:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2283:     return unless (ref($hashref) eq 'HASH');
                   2284:     if ($onchange) {
                   2285:         $onchange = ' onchange="'.$onchange.'"';
                   2286:     }
1.1228    raeburn  2287:     my $disabled;
                   2288:     if ($readonly) {
                   2289:         $disabled = ' disabled="disabled"';
                   2290:     }
                   2291:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2292:     my @keys;
1.970     raeburn  2293:     if (exists($hashref->{'select_form_order'})) {
                   2294: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2295:     } else {
1.970     raeburn  2296: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2297:     }
1.356     albertel 2298:     foreach my $key (@keys) {
                   2299:         $selectform.=
                   2300: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2301:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2302:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2303:     }
                   2304:     $selectform.="</select>";
                   2305:     return $selectform;
                   2306: }
                   2307: 
1.475     www      2308: # For display filters
                   2309: 
                   2310: sub display_filter {
1.1074    raeburn  2311:     my ($context) = @_;
1.475     www      2312:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2313:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2314:     my $phraseinput = 'hidden';
                   2315:     my $includeinput = 'hidden';
                   2316:     my ($checked,$includetypestext);
                   2317:     if ($env{'form.displayfilter'} eq 'containing') {
                   2318:         $phraseinput = 'text'; 
                   2319:         if ($context eq 'parmslog') {
                   2320:             $includeinput = 'checkbox';
                   2321:             if ($env{'form.includetypes'}) {
                   2322:                 $checked = ' checked="checked"';
                   2323:             }
                   2324:             $includetypestext = &mt('Include parameter types');
                   2325:         }
                   2326:     } else {
                   2327:         $includetypestext = '&nbsp;';
                   2328:     }
                   2329:     my ($additional,$secondid,$thirdid);
                   2330:     if ($context eq 'parmslog') {
                   2331:         $additional = 
                   2332:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2333:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2334:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2335:             '</label>';
                   2336:         $secondid = 'includetypes';
                   2337:         $thirdid = 'includetypestext';
                   2338:     }
                   2339:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2340:                                                     '$secondid','$thirdid')";
                   2341:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2342: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2343: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2344: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2345:            &mt('Filter: [_1]',
1.477     www      2346: 	   &select_form($env{'form.displayfilter'},
                   2347: 			'displayfilter',
1.970     raeburn  2348: 			{'currentfolder' => 'Current folder/page',
1.477     www      2349: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2350: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2351: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2352:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2353:                          '" />'.$additional;
                   2354: }
                   2355: 
                   2356: sub display_filter_js {
                   2357:     my $includetext = &mt('Include parameter types');
                   2358:     return <<"ENDJS";
                   2359:   
                   2360: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2361:     var firstType = 'hidden';
                   2362:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2363:         firstType = 'text';
                   2364:     }
                   2365:     firstObject = document.getElementById(firstid);
                   2366:     if (typeof(firstObject) == 'object') {
                   2367:         if (firstObject.type != firstType) {
                   2368:             changeInputType(firstObject,firstType);
                   2369:         }
                   2370:     }
                   2371:     if (context == 'parmslog') {
                   2372:         var secondType = 'hidden';
                   2373:         if (firstType == 'text') {
                   2374:             secondType = 'checkbox';
                   2375:         }
                   2376:         secondObject = document.getElementById(secondid);  
                   2377:         if (typeof(secondObject) == 'object') {
                   2378:             if (secondObject.type != secondType) {
                   2379:                 changeInputType(secondObject,secondType);
                   2380:             }
                   2381:         }
                   2382:         var textItem = document.getElementById(thirdid);
                   2383:         var currtext = textItem.innerHTML;
                   2384:         var newtext;
                   2385:         if (firstType == 'text') {
                   2386:             newtext = '$includetext';
                   2387:         } else {
                   2388:             newtext = '&nbsp;';
                   2389:         }
                   2390:         if (currtext != newtext) {
                   2391:             textItem.innerHTML = newtext;
                   2392:         }
                   2393:     }
                   2394:     return;
                   2395: }
                   2396: 
                   2397: function changeInputType(oldObject,newType) {
                   2398:     var newObject = document.createElement('input');
                   2399:     newObject.type = newType;
                   2400:     if (oldObject.size) {
                   2401:         newObject.size = oldObject.size;
                   2402:     }
                   2403:     if (oldObject.value) {
                   2404:         newObject.value = oldObject.value;
                   2405:     }
                   2406:     if (oldObject.name) {
                   2407:         newObject.name = oldObject.name;
                   2408:     }
                   2409:     if (oldObject.id) {
                   2410:         newObject.id = oldObject.id;
                   2411:     }
                   2412:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2413:     return;
                   2414: }
                   2415: 
                   2416: ENDJS
1.475     www      2417: }
                   2418: 
1.167     www      2419: sub gradeleveldescription {
                   2420:     my $gradelevel=shift;
                   2421:     my %gradelevels=(0 => 'Not specified',
                   2422: 		     1 => 'Grade 1',
                   2423: 		     2 => 'Grade 2',
                   2424: 		     3 => 'Grade 3',
                   2425: 		     4 => 'Grade 4',
                   2426: 		     5 => 'Grade 5',
                   2427: 		     6 => 'Grade 6',
                   2428: 		     7 => 'Grade 7',
                   2429: 		     8 => 'Grade 8',
                   2430: 		     9 => 'Grade 9',
                   2431: 		     10 => 'Grade 10',
                   2432: 		     11 => 'Grade 11',
                   2433: 		     12 => 'Grade 12',
                   2434: 		     13 => 'Grade 13',
                   2435: 		     14 => '100 Level',
                   2436: 		     15 => '200 Level',
                   2437: 		     16 => '300 Level',
                   2438: 		     17 => '400 Level',
                   2439: 		     18 => 'Graduate Level');
                   2440:     return &mt($gradelevels{$gradelevel});
                   2441: }
                   2442: 
1.163     www      2443: sub select_level_form {
                   2444:     my ($deflevel,$name)=@_;
                   2445:     unless ($deflevel) { $deflevel=0; }
1.167     www      2446:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2447:     for (my $i=0; $i<=18; $i++) {
                   2448:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2449:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2450:                 ">".&gradeleveldescription($i)."</option>\n";
                   2451:     }
                   2452:     $selectform.="</select>";
                   2453:     return $selectform;
1.163     www      2454: }
1.167     www      2455: 
1.35      matthew  2456: #-------------------------------------------
                   2457: 
1.45      matthew  2458: =pod
                   2459: 
1.1121    raeburn  2460: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2461: 
                   2462: Returns a string containing a <select name='$name' size='1'> form to 
                   2463: allow a user to select the domain to preform an operation in.  
                   2464: See loncreateuser.pm for an example invocation and use.
                   2465: 
1.90      www      2466: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2467: selected");
                   2468: 
1.743     raeburn  2469: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2470: 
1.910     raeburn  2471: 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.
                   2472: 
1.1121    raeburn  2473: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2474: 
                   2475: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2476: 
1.35      matthew  2477: =cut
                   2478: 
                   2479: #-------------------------------------------
1.34      matthew  2480: sub select_dom_form {
1.1121    raeburn  2481:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2482:     if ($onchange) {
1.874     raeburn  2483:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2484:     }
1.1121    raeburn  2485:     my (@domains,%exclude);
1.910     raeburn  2486:     if (ref($incdoms) eq 'ARRAY') {
                   2487:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2488:     } else {
                   2489:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2490:     }
1.90      www      2491:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2492:     if (ref($excdoms) eq 'ARRAY') {
                   2493:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2494:     }
1.743     raeburn  2495:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2496:     foreach my $dom (@domains) {
1.1121    raeburn  2497:         next if ($exclude{$dom});
1.356     albertel 2498:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2499:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2500:         if ($showdomdesc) {
                   2501:             if ($dom ne '') {
                   2502:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2503:                 if ($domdesc ne '') {
                   2504:                     $selectdomain .= ' ('.$domdesc.')';
                   2505:                 }
                   2506:             } 
                   2507:         }
                   2508:         $selectdomain .= "</option>\n";
1.34      matthew  2509:     }
                   2510:     $selectdomain.="</select>";
                   2511:     return $selectdomain;
                   2512: }
                   2513: 
1.35      matthew  2514: #-------------------------------------------
                   2515: 
1.45      matthew  2516: =pod
                   2517: 
1.648     raeburn  2518: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2519: 
1.586     raeburn  2520: input: 4 arguments (two required, two optional) - 
                   2521:     $domain - domain of new user
                   2522:     $name - name of form element
                   2523:     $default - Value of 'default' causes a default item to be first 
                   2524:                             option, and selected by default. 
                   2525:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2526:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2527: output: returns 2 items: 
1.586     raeburn  2528: (a) form element which contains either:
                   2529:    (i) <select name="$name">
                   2530:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2531:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2532:        </select>
                   2533:        form item if there are multiple library servers in $domain, or
                   2534:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2535:        if there is only one library server in $domain.
                   2536: 
                   2537: (b) number of library servers found.
                   2538: 
                   2539: See loncreateuser.pm for example of use.
1.35      matthew  2540: 
                   2541: =cut
                   2542: 
                   2543: #-------------------------------------------
1.586     raeburn  2544: sub home_server_form_item {
                   2545:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2546:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2547:     my $result;
                   2548:     my $numlib = keys(%servers);
                   2549:     if ($numlib > 1) {
                   2550:         $result .= '<select name="'.$name.'" />'."\n";
                   2551:         if ($default) {
1.804     bisitz   2552:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2553:                        '</option>'."\n";
                   2554:         }
                   2555:         foreach my $hostid (sort(keys(%servers))) {
                   2556:             $result.= '<option value="'.$hostid.'">'.
                   2557: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2558:         }
                   2559:         $result .= '</select>'."\n";
                   2560:     } elsif ($numlib == 1) {
                   2561:         my $hostid;
                   2562:         foreach my $item (keys(%servers)) {
                   2563:             $hostid = $item;
                   2564:         }
                   2565:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2566:                    $hostid.'" />';
                   2567:                    if (!$hide) {
                   2568:                        $result .= $hostid.' '.$servers{$hostid};
                   2569:                    }
                   2570:                    $result .= "\n";
                   2571:     } elsif ($default) {
                   2572:         $result .= '<input type="hidden" name="'.$name.
                   2573:                    '" value="default" />';
                   2574:                    if (!$hide) {
                   2575:                        $result .= &mt('default');
                   2576:                    }
                   2577:                    $result .= "\n";
1.33      matthew  2578:     }
1.586     raeburn  2579:     return ($result,$numlib);
1.33      matthew  2580: }
1.112     bowersj2 2581: 
                   2582: =pod
                   2583: 
1.534     albertel 2584: =back 
                   2585: 
1.112     bowersj2 2586: =cut
1.87      matthew  2587: 
                   2588: ###############################################################
1.112     bowersj2 2589: ##                  Decoding User Agent                      ##
1.87      matthew  2590: ###############################################################
                   2591: 
                   2592: =pod
                   2593: 
1.112     bowersj2 2594: =head1 Decoding the User Agent
                   2595: 
                   2596: =over 4
                   2597: 
                   2598: =item * &decode_user_agent()
1.87      matthew  2599: 
                   2600: Inputs: $r
                   2601: 
                   2602: Outputs:
                   2603: 
                   2604: =over 4
                   2605: 
1.112     bowersj2 2606: =item * $httpbrowser
1.87      matthew  2607: 
1.112     bowersj2 2608: =item * $clientbrowser
1.87      matthew  2609: 
1.112     bowersj2 2610: =item * $clientversion
1.87      matthew  2611: 
1.112     bowersj2 2612: =item * $clientmathml
1.87      matthew  2613: 
1.112     bowersj2 2614: =item * $clientunicode
1.87      matthew  2615: 
1.112     bowersj2 2616: =item * $clientos
1.87      matthew  2617: 
1.1137    raeburn  2618: =item * $clientmobile
                   2619: 
1.1141    raeburn  2620: =item * $clientinfo
                   2621: 
1.1194    raeburn  2622: =item * $clientosversion
                   2623: 
1.87      matthew  2624: =back
                   2625: 
1.157     matthew  2626: =back 
                   2627: 
1.87      matthew  2628: =cut
                   2629: 
                   2630: ###############################################################
                   2631: ###############################################################
                   2632: sub decode_user_agent {
1.247     albertel 2633:     my ($r)=@_;
1.87      matthew  2634:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2635:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2636:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2637:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2638:     my $clientbrowser='unknown';
                   2639:     my $clientversion='0';
                   2640:     my $clientmathml='';
                   2641:     my $clientunicode='0';
1.1137    raeburn  2642:     my $clientmobile=0;
1.1194    raeburn  2643:     my $clientosversion='';
1.87      matthew  2644:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1193    raeburn  2645:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2646: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2647: 	    $clientbrowser=$bname;
                   2648:             $httpbrowser=~/$vreg/i;
                   2649: 	    $clientversion=$1;
                   2650:             $clientmathml=($clientversion>=$minv);
                   2651:             $clientunicode=($clientversion>=$univ);
                   2652: 	}
                   2653:     }
                   2654:     my $clientos='unknown';
1.1141    raeburn  2655:     my $clientinfo;
1.87      matthew  2656:     if (($httpbrowser=~/linux/i) ||
                   2657:         ($httpbrowser=~/unix/i) ||
                   2658:         ($httpbrowser=~/ux/i) ||
                   2659:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2660:     if (($httpbrowser=~/vax/i) ||
                   2661:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2662:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2663:     if (($httpbrowser=~/mac/i) ||
                   2664:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194    raeburn  2665:     if ($httpbrowser=~/win/i) {
                   2666:         $clientos='win';
                   2667:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2668:             $clientosversion = $1;
                   2669:         }
                   2670:     }
1.87      matthew  2671:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2672:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2673:         $clientmobile=lc($1);
                   2674:     }
1.1141    raeburn  2675:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2676:         $clientinfo = 'firefox-'.$1;
                   2677:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2678:         $clientinfo = 'chromeframe-'.$1;
                   2679:     }
1.87      matthew  2680:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194    raeburn  2681:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2682:             $clientosversion);
1.87      matthew  2683: }
                   2684: 
1.32      matthew  2685: ###############################################################
                   2686: ##    Authentication changing form generation subroutines    ##
                   2687: ###############################################################
                   2688: ##
                   2689: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2690: ## hash, and have reasonable default values.
                   2691: ##
                   2692: ##    formname = the name given in the <form> tag.
1.35      matthew  2693: #-------------------------------------------
                   2694: 
1.45      matthew  2695: =pod
                   2696: 
1.112     bowersj2 2697: =head1 Authentication Routines
                   2698: 
                   2699: =over 4
                   2700: 
1.648     raeburn  2701: =item * &authform_xxxxxx()
1.35      matthew  2702: 
                   2703: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2704: handle some of the conveniences required for authentication forms.  
                   2705: This is not an optimal method, but it works.  
                   2706: 
                   2707: =over 4
                   2708: 
1.112     bowersj2 2709: =item * authform_header
1.35      matthew  2710: 
1.112     bowersj2 2711: =item * authform_authorwarning
1.35      matthew  2712: 
1.112     bowersj2 2713: =item * authform_nochange
1.35      matthew  2714: 
1.112     bowersj2 2715: =item * authform_kerberos
1.35      matthew  2716: 
1.112     bowersj2 2717: =item * authform_internal
1.35      matthew  2718: 
1.112     bowersj2 2719: =item * authform_filesystem
1.35      matthew  2720: 
                   2721: =back
                   2722: 
1.648     raeburn  2723: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2724: 
1.35      matthew  2725: =cut
                   2726: 
                   2727: #-------------------------------------------
1.32      matthew  2728: sub authform_header{  
                   2729:     my %in = (
                   2730:         formname => 'cu',
1.80      albertel 2731:         kerb_def_dom => '',
1.32      matthew  2732:         @_,
                   2733:     );
                   2734:     $in{'formname'} = 'document.' . $in{'formname'};
                   2735:     my $result='';
1.80      albertel 2736: 
                   2737: #---------------------------------------------- Code for upper case translation
                   2738:     my $Javascript_toUpperCase;
                   2739:     unless ($in{kerb_def_dom}) {
                   2740:         $Javascript_toUpperCase =<<"END";
                   2741:         switch (choice) {
                   2742:            case 'krb': currentform.elements[choicearg].value =
                   2743:                currentform.elements[choicearg].value.toUpperCase();
                   2744:                break;
                   2745:            default:
                   2746:         }
                   2747: END
                   2748:     } else {
                   2749:         $Javascript_toUpperCase = "";
                   2750:     }
                   2751: 
1.165     raeburn  2752:     my $radioval = "'nochange'";
1.591     raeburn  2753:     if (defined($in{'curr_authtype'})) {
                   2754:         if ($in{'curr_authtype'} ne '') {
                   2755:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2756:         }
1.174     matthew  2757:     }
1.165     raeburn  2758:     my $argfield = 'null';
1.591     raeburn  2759:     if (defined($in{'mode'})) {
1.165     raeburn  2760:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2761:             if (defined($in{'curr_autharg'})) {
                   2762:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2763:                     $argfield = "'$in{'curr_autharg'}'";
                   2764:                 }
                   2765:             }
                   2766:         }
                   2767:     }
                   2768: 
1.32      matthew  2769:     $result.=<<"END";
                   2770: var current = new Object();
1.165     raeburn  2771: current.radiovalue = $radioval;
                   2772: current.argfield = $argfield;
1.32      matthew  2773: 
                   2774: function changed_radio(choice,currentform) {
                   2775:     var choicearg = choice + 'arg';
                   2776:     // If a radio button in changed, we need to change the argfield
                   2777:     if (current.radiovalue != choice) {
                   2778:         current.radiovalue = choice;
                   2779:         if (current.argfield != null) {
                   2780:             currentform.elements[current.argfield].value = '';
                   2781:         }
                   2782:         if (choice == 'nochange') {
                   2783:             current.argfield = null;
                   2784:         } else {
                   2785:             current.argfield = choicearg;
                   2786:             switch(choice) {
                   2787:                 case 'krb': 
                   2788:                     currentform.elements[current.argfield].value = 
                   2789:                         "$in{'kerb_def_dom'}";
                   2790:                 break;
                   2791:               default:
                   2792:                 break;
                   2793:             }
                   2794:         }
                   2795:     }
                   2796:     return;
                   2797: }
1.22      www      2798: 
1.32      matthew  2799: function changed_text(choice,currentform) {
                   2800:     var choicearg = choice + 'arg';
                   2801:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2802:         $Javascript_toUpperCase
1.32      matthew  2803:         // clear old field
                   2804:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2805:             currentform.elements[current.argfield].value = '';
                   2806:         }
                   2807:         current.argfield = choicearg;
                   2808:     }
                   2809:     set_auth_radio_buttons(choice,currentform);
                   2810:     return;
1.20      www      2811: }
1.32      matthew  2812: 
                   2813: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2814:     var numauthchoices = currentform.login.length;
                   2815:     if (typeof numauthchoices  == "undefined") {
                   2816:         return;
                   2817:     } 
1.32      matthew  2818:     var i=0;
1.986     raeburn  2819:     while (i < numauthchoices) {
1.32      matthew  2820:         if (currentform.login[i].value == newvalue) { break; }
                   2821:         i++;
                   2822:     }
1.986     raeburn  2823:     if (i == numauthchoices) {
1.32      matthew  2824:         return;
                   2825:     }
                   2826:     current.radiovalue = newvalue;
                   2827:     currentform.login[i].checked = true;
                   2828:     return;
                   2829: }
                   2830: END
                   2831:     return $result;
                   2832: }
                   2833: 
1.1106    raeburn  2834: sub authform_authorwarning {
1.32      matthew  2835:     my $result='';
1.144     matthew  2836:     $result='<i>'.
                   2837:         &mt('As a general rule, only authors or co-authors should be '.
                   2838:             'filesystem authenticated '.
                   2839:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2840:     return $result;
                   2841: }
                   2842: 
1.1106    raeburn  2843: sub authform_nochange {
1.32      matthew  2844:     my %in = (
                   2845:               formname => 'document.cu',
                   2846:               kerb_def_dom => 'MSU.EDU',
                   2847:               @_,
                   2848:           );
1.1106    raeburn  2849:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2850:     my $result;
1.1104    raeburn  2851:     if (!$authnum) {
1.1105    raeburn  2852:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2853:     } else {
                   2854:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2855:                   '<input type="radio" name="login" value="nochange" '.
                   2856:                   'checked="checked" onclick="'.
1.281     albertel 2857:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2858: 	    '</label>';
1.586     raeburn  2859:     }
1.32      matthew  2860:     return $result;
                   2861: }
                   2862: 
1.591     raeburn  2863: sub authform_kerberos {
1.32      matthew  2864:     my %in = (
                   2865:               formname => 'document.cu',
                   2866:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2867:               kerb_def_auth => 'krb4',
1.32      matthew  2868:               @_,
                   2869:               );
1.586     raeburn  2870:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2871:         $autharg,$jscall);
1.1106    raeburn  2872:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2873:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2874:        $check5 = ' checked="checked"';
1.80      albertel 2875:     } else {
1.772     bisitz   2876:        $check4 = ' checked="checked"';
1.80      albertel 2877:     }
1.165     raeburn  2878:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2879:     if (defined($in{'curr_authtype'})) {
                   2880:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2881:             $krbcheck = ' checked="checked"';
1.623     raeburn  2882:             if (defined($in{'mode'})) {
                   2883:                 if ($in{'mode'} eq 'modifyuser') {
                   2884:                     $krbcheck = '';
                   2885:                 }
                   2886:             }
1.591     raeburn  2887:             if (defined($in{'curr_kerb_ver'})) {
                   2888:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2889:                     $check5 = ' checked="checked"';
1.591     raeburn  2890:                     $check4 = '';
                   2891:                 } else {
1.772     bisitz   2892:                     $check4 = ' checked="checked"';
1.591     raeburn  2893:                     $check5 = '';
                   2894:                 }
1.586     raeburn  2895:             }
1.591     raeburn  2896:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2897:                 $krbarg = $in{'curr_autharg'};
                   2898:             }
1.586     raeburn  2899:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2900:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2901:                     $result = 
                   2902:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2903:         $in{'curr_autharg'},$krbver);
                   2904:                 } else {
                   2905:                     $result =
                   2906:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2907:                 }
                   2908:                 return $result; 
                   2909:             }
                   2910:         }
                   2911:     } else {
                   2912:         if ($authnum == 1) {
1.784     bisitz   2913:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2914:         }
                   2915:     }
1.586     raeburn  2916:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2917:         return;
1.587     raeburn  2918:     } elsif ($authtype eq '') {
1.591     raeburn  2919:         if (defined($in{'mode'})) {
1.587     raeburn  2920:             if ($in{'mode'} eq 'modifycourse') {
                   2921:                 if ($authnum == 1) {
1.1104    raeburn  2922:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2923:                 }
                   2924:             }
                   2925:         }
1.586     raeburn  2926:     }
                   2927:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2928:     if ($authtype eq '') {
                   2929:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2930:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2931:                     $krbcheck.' />';
                   2932:     }
                   2933:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2934:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2935:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2936:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2937:          $in{'curr_authtype'} eq 'krb4')) {
                   2938:         $result .= &mt
1.144     matthew  2939:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2940:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2941:          '<label>'.$authtype,
1.281     albertel 2942:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2943:              'value="'.$krbarg.'" '.
1.144     matthew  2944:              'onchange="'.$jscall.'" />',
1.281     albertel 2945:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2946:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2947: 	 '</label>');
1.586     raeburn  2948:     } elsif ($can_assign{'krb4'}) {
                   2949:         $result .= &mt
                   2950:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2951:          '[_3] Version 4 [_4]',
                   2952:          '<label>'.$authtype,
                   2953:          '</label><input type="text" size="10" name="krbarg" '.
                   2954:              'value="'.$krbarg.'" '.
                   2955:              'onchange="'.$jscall.'" />',
                   2956:          '<label><input type="hidden" name="krbver" value="4" />',
                   2957:          '</label>');
                   2958:     } elsif ($can_assign{'krb5'}) {
                   2959:         $result .= &mt
                   2960:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2961:          '[_3] Version 5 [_4]',
                   2962:          '<label>'.$authtype,
                   2963:          '</label><input type="text" size="10" name="krbarg" '.
                   2964:              'value="'.$krbarg.'" '.
                   2965:              'onchange="'.$jscall.'" />',
                   2966:          '<label><input type="hidden" name="krbver" value="5" />',
                   2967:          '</label>');
                   2968:     }
1.32      matthew  2969:     return $result;
                   2970: }
                   2971: 
1.1106    raeburn  2972: sub authform_internal {
1.586     raeburn  2973:     my %in = (
1.32      matthew  2974:                 formname => 'document.cu',
                   2975:                 kerb_def_dom => 'MSU.EDU',
                   2976:                 @_,
                   2977:                 );
1.586     raeburn  2978:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2979:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2980:     if (defined($in{'curr_authtype'})) {
                   2981:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2982:             if ($can_assign{'int'}) {
1.772     bisitz   2983:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2984:                 if (defined($in{'mode'})) {
                   2985:                     if ($in{'mode'} eq 'modifyuser') {
                   2986:                         $intcheck = '';
                   2987:                     }
                   2988:                 }
1.591     raeburn  2989:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2990:                     $intarg = $in{'curr_autharg'};
                   2991:                 }
                   2992:             } else {
                   2993:                 $result = &mt('Currently internally authenticated.');
                   2994:                 return $result;
1.165     raeburn  2995:             }
                   2996:         }
1.586     raeburn  2997:     } else {
                   2998:         if ($authnum == 1) {
1.784     bisitz   2999:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  3000:         }
                   3001:     }
                   3002:     if (!$can_assign{'int'}) {
                   3003:         return;
1.587     raeburn  3004:     } elsif ($authtype eq '') {
1.591     raeburn  3005:         if (defined($in{'mode'})) {
1.587     raeburn  3006:             if ($in{'mode'} eq 'modifycourse') {
                   3007:                 if ($authnum == 1) {
1.1104    raeburn  3008:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  3009:                 }
                   3010:             }
                   3011:         }
1.165     raeburn  3012:     }
1.586     raeburn  3013:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3014:     if ($authtype eq '') {
                   3015:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   3016:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   3017:     }
1.605     bisitz   3018:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  3019:                $intarg.'" onchange="'.$jscall.'" />';
                   3020:     $result = &mt
1.144     matthew  3021:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3022:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   3023:     $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  3024:     return $result;
                   3025: }
                   3026: 
1.1104    raeburn  3027: sub authform_local {
1.32      matthew  3028:     my %in = (
                   3029:               formname => 'document.cu',
                   3030:               kerb_def_dom => 'MSU.EDU',
                   3031:               @_,
                   3032:               );
1.586     raeburn  3033:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3034:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3035:     if (defined($in{'curr_authtype'})) {
                   3036:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3037:             if ($can_assign{'loc'}) {
1.772     bisitz   3038:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3039:                 if (defined($in{'mode'})) {
                   3040:                     if ($in{'mode'} eq 'modifyuser') {
                   3041:                         $loccheck = '';
                   3042:                     }
                   3043:                 }
1.591     raeburn  3044:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3045:                     $locarg = $in{'curr_autharg'};
                   3046:                 }
                   3047:             } else {
                   3048:                 $result = &mt('Currently using local (institutional) authentication.');
                   3049:                 return $result;
1.165     raeburn  3050:             }
                   3051:         }
1.586     raeburn  3052:     } else {
                   3053:         if ($authnum == 1) {
1.784     bisitz   3054:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3055:         }
                   3056:     }
                   3057:     if (!$can_assign{'loc'}) {
                   3058:         return;
1.587     raeburn  3059:     } elsif ($authtype eq '') {
1.591     raeburn  3060:         if (defined($in{'mode'})) {
1.587     raeburn  3061:             if ($in{'mode'} eq 'modifycourse') {
                   3062:                 if ($authnum == 1) {
1.1104    raeburn  3063:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  3064:                 }
                   3065:             }
                   3066:         }
1.165     raeburn  3067:     }
1.586     raeburn  3068:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3069:     if ($authtype eq '') {
                   3070:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3071:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   3072:                     $jscall.'" />';
                   3073:     }
                   3074:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   3075:                $locarg.'" onchange="'.$jscall.'" />';
                   3076:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3077:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3078:     return $result;
                   3079: }
                   3080: 
1.1106    raeburn  3081: sub authform_filesystem {
1.32      matthew  3082:     my %in = (
                   3083:               formname => 'document.cu',
                   3084:               kerb_def_dom => 'MSU.EDU',
                   3085:               @_,
                   3086:               );
1.586     raeburn  3087:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3088:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3089:     if (defined($in{'curr_authtype'})) {
                   3090:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3091:             if ($can_assign{'fsys'}) {
1.772     bisitz   3092:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3093:                 if (defined($in{'mode'})) {
                   3094:                     if ($in{'mode'} eq 'modifyuser') {
                   3095:                         $fsyscheck = '';
                   3096:                     }
                   3097:                 }
1.586     raeburn  3098:             } else {
                   3099:                 $result = &mt('Currently Filesystem Authenticated.');
                   3100:                 return $result;
                   3101:             }           
                   3102:         }
                   3103:     } else {
                   3104:         if ($authnum == 1) {
1.784     bisitz   3105:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3106:         }
                   3107:     }
                   3108:     if (!$can_assign{'fsys'}) {
                   3109:         return;
1.587     raeburn  3110:     } elsif ($authtype eq '') {
1.591     raeburn  3111:         if (defined($in{'mode'})) {
1.587     raeburn  3112:             if ($in{'mode'} eq 'modifycourse') {
                   3113:                 if ($authnum == 1) {
1.1104    raeburn  3114:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  3115:                 }
                   3116:             }
                   3117:         }
1.586     raeburn  3118:     }
                   3119:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3120:     if ($authtype eq '') {
                   3121:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3122:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   3123:                     $jscall.'" />';
                   3124:     }
                   3125:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   3126:                ' onchange="'.$jscall.'" />';
                   3127:     $result = &mt
1.144     matthew  3128:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 3129:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  3130:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   3131:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  3132:                   'onchange="'.$jscall.'" />');
1.32      matthew  3133:     return $result;
                   3134: }
                   3135: 
1.586     raeburn  3136: sub get_assignable_auth {
                   3137:     my ($dom) = @_;
                   3138:     if ($dom eq '') {
                   3139:         $dom = $env{'request.role.domain'};
                   3140:     }
                   3141:     my %can_assign = (
                   3142:                           krb4 => 1,
                   3143:                           krb5 => 1,
                   3144:                           int  => 1,
                   3145:                           loc  => 1,
                   3146:                      );
                   3147:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3148:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3149:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3150:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3151:             my $context;
                   3152:             if ($env{'request.role'} =~ /^au/) {
                   3153:                 $context = 'author';
                   3154:             } elsif ($env{'request.role'} =~ /^dc/) {
                   3155:                 $context = 'domain';
                   3156:             } elsif ($env{'request.course.id'}) {
                   3157:                 $context = 'course';
                   3158:             }
                   3159:             if ($context) {
                   3160:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3161:                    %can_assign = %{$authhash->{$context}}; 
                   3162:                 }
                   3163:             }
                   3164:         }
                   3165:     }
                   3166:     my $authnum = 0;
                   3167:     foreach my $key (keys(%can_assign)) {
                   3168:         if ($can_assign{$key}) {
                   3169:             $authnum ++;
                   3170:         }
                   3171:     }
                   3172:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3173:         $authnum --;
                   3174:     }
                   3175:     return ($authnum,%can_assign);
                   3176: }
                   3177: 
1.80      albertel 3178: ###############################################################
                   3179: ##    Get Kerberos Defaults for Domain                 ##
                   3180: ###############################################################
                   3181: ##
                   3182: ## Returns default kerberos version and an associated argument
                   3183: ## as listed in file domain.tab. If not listed, provides
                   3184: ## appropriate default domain and kerberos version.
                   3185: ##
                   3186: #-------------------------------------------
                   3187: 
                   3188: =pod
                   3189: 
1.648     raeburn  3190: =item * &get_kerberos_defaults()
1.80      albertel 3191: 
                   3192: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3193: version and domain. If not found, it defaults to version 4 and the 
                   3194: domain of the server.
1.80      albertel 3195: 
1.648     raeburn  3196: =over 4
                   3197: 
1.80      albertel 3198: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3199: 
1.648     raeburn  3200: =back
                   3201: 
                   3202: =back
                   3203: 
1.80      albertel 3204: =cut
                   3205: 
                   3206: #-------------------------------------------
                   3207: sub get_kerberos_defaults {
                   3208:     my $domain=shift;
1.641     raeburn  3209:     my ($krbdef,$krbdefdom);
                   3210:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3211:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3212:         $krbdef = $domdefaults{'auth_def'};
                   3213:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3214:     } else {
1.80      albertel 3215:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3216:         my $krbdefdom=$1;
                   3217:         $krbdefdom=~tr/a-z/A-Z/;
                   3218:         $krbdef = "krb4";
                   3219:     }
                   3220:     return ($krbdef,$krbdefdom);
                   3221: }
1.112     bowersj2 3222: 
1.32      matthew  3223: 
1.46      matthew  3224: ###############################################################
                   3225: ##                Thesaurus Functions                        ##
                   3226: ###############################################################
1.20      www      3227: 
1.46      matthew  3228: =pod
1.20      www      3229: 
1.112     bowersj2 3230: =head1 Thesaurus Functions
                   3231: 
                   3232: =over 4
                   3233: 
1.648     raeburn  3234: =item * &initialize_keywords()
1.46      matthew  3235: 
                   3236: Initializes the package variable %Keywords if it is empty.  Uses the
                   3237: package variable $thesaurus_db_file.
                   3238: 
                   3239: =cut
                   3240: 
                   3241: ###################################################
                   3242: 
                   3243: sub initialize_keywords {
                   3244:     return 1 if (scalar keys(%Keywords));
                   3245:     # If we are here, %Keywords is empty, so fill it up
                   3246:     #   Make sure the file we need exists...
                   3247:     if (! -e $thesaurus_db_file) {
                   3248:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3249:                                  " failed because it does not exist");
                   3250:         return 0;
                   3251:     }
                   3252:     #   Set up the hash as a database
                   3253:     my %thesaurus_db;
                   3254:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3255:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3256:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3257:                                  $thesaurus_db_file);
                   3258:         return 0;
                   3259:     } 
                   3260:     #  Get the average number of appearances of a word.
                   3261:     my $avecount = $thesaurus_db{'average.count'};
                   3262:     #  Put keywords (those that appear > average) into %Keywords
                   3263:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3264:         my ($count,undef) = split /:/,$data;
                   3265:         $Keywords{$word}++ if ($count > $avecount);
                   3266:     }
                   3267:     untie %thesaurus_db;
                   3268:     # Remove special values from %Keywords.
1.356     albertel 3269:     foreach my $value ('total.count','average.count') {
                   3270:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3271:   }
1.46      matthew  3272:     return 1;
                   3273: }
                   3274: 
                   3275: ###################################################
                   3276: 
                   3277: =pod
                   3278: 
1.648     raeburn  3279: =item * &keyword($word)
1.46      matthew  3280: 
                   3281: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3282: than the average number of times in the thesaurus database.  Calls 
                   3283: &initialize_keywords
                   3284: 
                   3285: =cut
                   3286: 
                   3287: ###################################################
1.20      www      3288: 
                   3289: sub keyword {
1.46      matthew  3290:     return if (!&initialize_keywords());
                   3291:     my $word=lc(shift());
                   3292:     $word=~s/\W//g;
                   3293:     return exists($Keywords{$word});
1.20      www      3294: }
1.46      matthew  3295: 
                   3296: ###############################################################
                   3297: 
                   3298: =pod 
1.20      www      3299: 
1.648     raeburn  3300: =item * &get_related_words()
1.46      matthew  3301: 
1.160     matthew  3302: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3303: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3304: will be returned.  The order of the words returned is determined by the
                   3305: database which holds them.
                   3306: 
                   3307: Uses global $thesaurus_db_file.
                   3308: 
1.1057    foxr     3309: 
1.46      matthew  3310: =cut
                   3311: 
                   3312: ###############################################################
                   3313: sub get_related_words {
                   3314:     my $keyword = shift;
                   3315:     my %thesaurus_db;
                   3316:     if (! -e $thesaurus_db_file) {
                   3317:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3318:                                  "failed because the file does not exist");
                   3319:         return ();
                   3320:     }
                   3321:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3322:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3323:         return ();
                   3324:     } 
                   3325:     my @Words=();
1.429     www      3326:     my $count=0;
1.46      matthew  3327:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3328: 	# The first element is the number of times
                   3329: 	# the word appears.  We do not need it now.
1.429     www      3330: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3331: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3332: 	my $threshold=$mostfrequentcount/10;
                   3333:         foreach my $possibleword (@RelatedWords) {
                   3334:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3335:             if ($wordcount>$threshold) {
                   3336: 		push(@Words,$word);
                   3337:                 $count++;
                   3338:                 if ($count>10) { last; }
                   3339: 	    }
1.20      www      3340:         }
                   3341:     }
1.46      matthew  3342:     untie %thesaurus_db;
                   3343:     return @Words;
1.14      harris41 3344: }
1.1090    foxr     3345: ###############################################################
                   3346: #
                   3347: #  Spell checking
                   3348: #
                   3349: 
                   3350: =pod
                   3351: 
1.1142    raeburn  3352: =back
                   3353: 
1.1090    foxr     3354: =head1 Spell checking
                   3355: 
                   3356: =over 4
                   3357: 
                   3358: =item * &check_spelling($wordlist $language)
                   3359: 
                   3360: Takes a string containing words and feeds it to an external
                   3361: spellcheck program via a pipeline. Returns a string containing
                   3362: them mis-spelled words.
                   3363: 
                   3364: Parameters:
                   3365: 
                   3366: =over 4
                   3367: 
                   3368: =item - $wordlist
                   3369: 
                   3370: String that will be fed into the spellcheck program.
                   3371: 
                   3372: =item - $language
                   3373: 
                   3374: Language string that specifies the language for which the spell
                   3375: check will be performed.
                   3376: 
                   3377: =back
                   3378: 
                   3379: =back
                   3380: 
                   3381: Note: This sub assumes that aspell is installed.
                   3382: 
                   3383: 
                   3384: =cut
                   3385: 
1.46      matthew  3386: 
1.1090    foxr     3387: sub check_spelling {
                   3388:     my ($wordlist, $language) = @_;
1.1091    foxr     3389:     my @misspellings;
                   3390:     
                   3391:     # Generate the speller and set the langauge.
                   3392:     # if explicitly selected:
1.1090    foxr     3393: 
1.1091    foxr     3394:     my $speller = Text::Aspell->new;
1.1090    foxr     3395:     if ($language) {
1.1091    foxr     3396: 	$speller->set_option('lang', $language);
1.1090    foxr     3397:     }
                   3398: 
1.1091    foxr     3399:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3400: 
1.1091    foxr     3401:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3402: 
1.1091    foxr     3403:     foreach my $word (@words) {
                   3404: 	if(! $speller->check($word)) {
                   3405: 	    push(@misspellings, $word);
1.1090    foxr     3406: 	}
                   3407:     }
1.1091    foxr     3408:     return join(' ', @misspellings);
                   3409:     
1.1090    foxr     3410: }
                   3411: 
1.61      www      3412: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3413: =pod
                   3414: 
1.112     bowersj2 3415: =head1 User Name Functions
                   3416: 
                   3417: =over 4
                   3418: 
1.648     raeburn  3419: =item * &plainname($uname,$udom,$first)
1.81      albertel 3420: 
1.112     bowersj2 3421: Takes a users logon name and returns it as a string in
1.226     albertel 3422: "first middle last generation" form 
                   3423: if $first is set to 'lastname' then it returns it as
                   3424: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3425: 
                   3426: =cut
1.61      www      3427: 
1.295     www      3428: 
1.81      albertel 3429: ###############################################################
1.61      www      3430: sub plainname {
1.226     albertel 3431:     my ($uname,$udom,$first)=@_;
1.537     albertel 3432:     return if (!defined($uname) || !defined($udom));
1.295     www      3433:     my %names=&getnames($uname,$udom);
1.226     albertel 3434:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3435: 					  $names{'middlename'},
                   3436: 					  $names{'lastname'},
                   3437: 					  $names{'generation'},$first);
                   3438:     $name=~s/^\s+//;
1.62      www      3439:     $name=~s/\s+$//;
                   3440:     $name=~s/\s+/ /g;
1.353     albertel 3441:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3442:     return $name;
1.61      www      3443: }
1.66      www      3444: 
                   3445: # -------------------------------------------------------------------- Nickname
1.81      albertel 3446: =pod
                   3447: 
1.648     raeburn  3448: =item * &nickname($uname,$udom)
1.81      albertel 3449: 
                   3450: Gets a users name and returns it as a string as
                   3451: 
                   3452: "&quot;nickname&quot;"
1.66      www      3453: 
1.81      albertel 3454: if the user has a nickname or
                   3455: 
                   3456: "first middle last generation"
                   3457: 
                   3458: if the user does not
                   3459: 
                   3460: =cut
1.66      www      3461: 
                   3462: sub nickname {
                   3463:     my ($uname,$udom)=@_;
1.537     albertel 3464:     return if (!defined($uname) || !defined($udom));
1.295     www      3465:     my %names=&getnames($uname,$udom);
1.68      albertel 3466:     my $name=$names{'nickname'};
1.66      www      3467:     if ($name) {
                   3468:        $name='&quot;'.$name.'&quot;'; 
                   3469:     } else {
                   3470:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3471: 	     $names{'lastname'}.' '.$names{'generation'};
                   3472:        $name=~s/\s+$//;
                   3473:        $name=~s/\s+/ /g;
                   3474:     }
                   3475:     return $name;
                   3476: }
                   3477: 
1.295     www      3478: sub getnames {
                   3479:     my ($uname,$udom)=@_;
1.537     albertel 3480:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3481:     if ($udom eq 'public' && $uname eq 'public') {
                   3482: 	return ('lastname' => &mt('Public'));
                   3483:     }
1.295     www      3484:     my $id=$uname.':'.$udom;
                   3485:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3486:     if ($cached) {
                   3487: 	return %{$names};
                   3488:     } else {
                   3489: 	my %loadnames=&Apache::lonnet::get('environment',
                   3490:                     ['firstname','middlename','lastname','generation','nickname'],
                   3491: 					 $udom,$uname);
                   3492: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3493: 	return %loadnames;
                   3494:     }
                   3495: }
1.61      www      3496: 
1.542     raeburn  3497: # -------------------------------------------------------------------- getemails
1.648     raeburn  3498: 
1.542     raeburn  3499: =pod
                   3500: 
1.648     raeburn  3501: =item * &getemails($uname,$udom)
1.542     raeburn  3502: 
                   3503: Gets a user's email information and returns it as a hash with keys:
                   3504: notification, critnotification, permanentemail
                   3505: 
                   3506: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3507: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3508:  
1.648     raeburn  3509: 
1.542     raeburn  3510: =cut
                   3511: 
1.648     raeburn  3512: 
1.466     albertel 3513: sub getemails {
                   3514:     my ($uname,$udom)=@_;
                   3515:     if ($udom eq 'public' && $uname eq 'public') {
                   3516: 	return;
                   3517:     }
1.467     www      3518:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3519:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3520:     my $id=$uname.':'.$udom;
                   3521:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3522:     if ($cached) {
                   3523: 	return %{$names};
                   3524:     } else {
                   3525: 	my %loadnames=&Apache::lonnet::get('environment',
                   3526:                     			   ['notification','critnotification',
                   3527: 					    'permanentemail'],
                   3528: 					   $udom,$uname);
                   3529: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3530: 	return %loadnames;
                   3531:     }
                   3532: }
                   3533: 
1.551     albertel 3534: sub flush_email_cache {
                   3535:     my ($uname,$udom)=@_;
                   3536:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3537:     if (!$uname) { $uname=$env{'user.name'};   }
                   3538:     return if ($udom eq 'public' && $uname eq 'public');
                   3539:     my $id=$uname.':'.$udom;
                   3540:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3541: }
                   3542: 
1.728     raeburn  3543: # -------------------------------------------------------------------- getlangs
                   3544: 
                   3545: =pod
                   3546: 
                   3547: =item * &getlangs($uname,$udom)
                   3548: 
                   3549: Gets a user's language preference and returns it as a hash with key:
                   3550: language.
                   3551: 
                   3552: =cut
                   3553: 
                   3554: 
                   3555: sub getlangs {
                   3556:     my ($uname,$udom) = @_;
                   3557:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3558:     if (!$uname) { $uname=$env{'user.name'};   }
                   3559:     my $id=$uname.':'.$udom;
                   3560:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3561:     if ($cached) {
                   3562:         return %{$langs};
                   3563:     } else {
                   3564:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3565:                                            $udom,$uname);
                   3566:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3567:         return %loadlangs;
                   3568:     }
                   3569: }
                   3570: 
                   3571: sub flush_langs_cache {
                   3572:     my ($uname,$udom)=@_;
                   3573:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3574:     if (!$uname) { $uname=$env{'user.name'};   }
                   3575:     return if ($udom eq 'public' && $uname eq 'public');
                   3576:     my $id=$uname.':'.$udom;
                   3577:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3578: }
                   3579: 
1.61      www      3580: # ------------------------------------------------------------------ Screenname
1.81      albertel 3581: 
                   3582: =pod
                   3583: 
1.648     raeburn  3584: =item * &screenname($uname,$udom)
1.81      albertel 3585: 
                   3586: Gets a users screenname and returns it as a string
                   3587: 
                   3588: =cut
1.61      www      3589: 
                   3590: sub screenname {
                   3591:     my ($uname,$udom)=@_;
1.258     albertel 3592:     if ($uname eq $env{'user.name'} &&
                   3593: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3594:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3595:     return $names{'screenname'};
1.62      www      3596: }
                   3597: 
1.212     albertel 3598: 
1.802     bisitz   3599: # ------------------------------------------------------------- Confirm Wrapper
                   3600: =pod
                   3601: 
1.1142    raeburn  3602: =item * &confirmwrapper($message)
1.802     bisitz   3603: 
                   3604: Wrap messages about completion of operation in box
                   3605: 
                   3606: =cut
                   3607: 
                   3608: sub confirmwrapper {
                   3609:     my ($message)=@_;
                   3610:     if ($message) {
                   3611:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3612:                .$message."\n"
                   3613:                .'</div>'."\n";
                   3614:     } else {
                   3615:         return $message;
                   3616:     }
                   3617: }
                   3618: 
1.62      www      3619: # ------------------------------------------------------------- Message Wrapper
                   3620: 
                   3621: sub messagewrapper {
1.369     www      3622:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3623:     return 
1.441     albertel 3624:         '<a href="/adm/email?compose=individual&amp;'.
                   3625:         'recname='.$username.'&amp;recdom='.$domain.
                   3626: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3627:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3628: }
1.802     bisitz   3629: 
1.74      www      3630: # --------------------------------------------------------------- Notes Wrapper
                   3631: 
                   3632: sub noteswrapper {
                   3633:     my ($link,$un,$do)=@_;
                   3634:     return 
1.896     amueller 3635: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3636: }
1.802     bisitz   3637: 
1.62      www      3638: # ------------------------------------------------------------- Aboutme Wrapper
                   3639: 
                   3640: sub aboutmewrapper {
1.1070    raeburn  3641:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3642:     if (!defined($username)  && !defined($domain)) {
                   3643:         return;
                   3644:     }
1.1096    raeburn  3645:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3646: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3647: }
                   3648: 
                   3649: # ------------------------------------------------------------ Syllabus Wrapper
                   3650: 
                   3651: sub syllabuswrapper {
1.707     bisitz   3652:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3653:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3654: }
1.14      harris41 3655: 
1.802     bisitz   3656: # -----------------------------------------------------------------------------
                   3657: 
1.208     matthew  3658: sub track_student_link {
1.887     raeburn  3659:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3660:     my $link ="/adm/trackstudent?";
1.208     matthew  3661:     my $title = 'View recent activity';
                   3662:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3663:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3664:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3665:         $title .= ' of this student';
1.268     albertel 3666:     } 
1.208     matthew  3667:     if (defined($target) && $target !~ /^\s*$/) {
                   3668:         $target = qq{target="$target"};
                   3669:     } else {
                   3670:         $target = '';
                   3671:     }
1.268     albertel 3672:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3673:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3674:     $title = &mt($title);
                   3675:     $linktext = &mt($linktext);
1.448     albertel 3676:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3677: 	&help_open_topic('View_recent_activity');
1.208     matthew  3678: }
                   3679: 
1.781     raeburn  3680: sub slot_reservations_link {
                   3681:     my ($linktext,$sname,$sdom,$target) = @_;
                   3682:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3683:     my $title = 'View slot reservation history';
                   3684:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3685:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3686:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3687:         $title .= ' of this student';
                   3688:     }
                   3689:     if (defined($target) && $target !~ /^\s*$/) {
                   3690:         $target = qq{target="$target"};
                   3691:     } else {
                   3692:         $target = '';
                   3693:     }
                   3694:     $title = &mt($title);
                   3695:     $linktext = &mt($linktext);
                   3696:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3697: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3698: 
                   3699: }
                   3700: 
1.508     www      3701: # ===================================================== Display a student photo
                   3702: 
                   3703: 
1.509     albertel 3704: sub student_image_tag {
1.508     www      3705:     my ($domain,$user)=@_;
                   3706:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3707:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3708: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3709:     } else {
                   3710: 	return '';
                   3711:     }
                   3712: }
                   3713: 
1.112     bowersj2 3714: =pod
                   3715: 
                   3716: =back
                   3717: 
                   3718: =head1 Access .tab File Data
                   3719: 
                   3720: =over 4
                   3721: 
1.648     raeburn  3722: =item * &languageids() 
1.112     bowersj2 3723: 
                   3724: returns list of all language ids
                   3725: 
                   3726: =cut
                   3727: 
1.14      harris41 3728: sub languageids {
1.16      harris41 3729:     return sort(keys(%language));
1.14      harris41 3730: }
                   3731: 
1.112     bowersj2 3732: =pod
                   3733: 
1.648     raeburn  3734: =item * &languagedescription() 
1.112     bowersj2 3735: 
                   3736: returns description of a specified language id
                   3737: 
                   3738: =cut
                   3739: 
1.14      harris41 3740: sub languagedescription {
1.125     www      3741:     my $code=shift;
                   3742:     return  ($supported_language{$code}?'* ':'').
                   3743:             $language{$code}.
1.126     www      3744: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3745: }
                   3746: 
1.1048    foxr     3747: =pod
                   3748: 
                   3749: =item * &plainlanguagedescription
                   3750: 
                   3751: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3752: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3753: 
                   3754: =cut
                   3755: 
1.145     www      3756: sub plainlanguagedescription {
                   3757:     my $code=shift;
                   3758:     return $language{$code};
                   3759: }
                   3760: 
1.1048    foxr     3761: =pod
                   3762: 
                   3763: =item * &supportedlanguagecode
                   3764: 
                   3765: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3766: code.
                   3767: 
                   3768: =cut
                   3769: 
1.145     www      3770: sub supportedlanguagecode {
                   3771:     my $code=shift;
                   3772:     return $supported_language{$code};
1.97      www      3773: }
                   3774: 
1.112     bowersj2 3775: =pod
                   3776: 
1.1048    foxr     3777: =item * &latexlanguage()
                   3778: 
                   3779: Given a language key code returns the correspondnig language to use
                   3780: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3781: is no supported hyphenation for the language code.
                   3782: 
                   3783: =cut
                   3784: 
                   3785: sub latexlanguage {
                   3786:     my $code = shift;
                   3787:     return $latex_language{$code};
                   3788: }
                   3789: 
                   3790: =pod
                   3791: 
                   3792: =item * &latexhyphenation()
                   3793: 
                   3794: Same as above but what's supplied is the language as it might be stored
                   3795: in the metadata.
                   3796: 
                   3797: =cut
                   3798: 
                   3799: sub latexhyphenation {
                   3800:     my $key = shift;
                   3801:     return $latex_language_bykey{$key};
                   3802: }
                   3803: 
                   3804: =pod
                   3805: 
1.648     raeburn  3806: =item * &copyrightids() 
1.112     bowersj2 3807: 
                   3808: returns list of all copyrights
                   3809: 
                   3810: =cut
                   3811: 
                   3812: sub copyrightids {
                   3813:     return sort(keys(%cprtag));
                   3814: }
                   3815: 
                   3816: =pod
                   3817: 
1.648     raeburn  3818: =item * &copyrightdescription() 
1.112     bowersj2 3819: 
                   3820: returns description of a specified copyright id
                   3821: 
                   3822: =cut
                   3823: 
                   3824: sub copyrightdescription {
1.166     www      3825:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3826: }
1.197     matthew  3827: 
                   3828: =pod
                   3829: 
1.648     raeburn  3830: =item * &source_copyrightids() 
1.192     taceyjo1 3831: 
                   3832: returns list of all source copyrights
                   3833: 
                   3834: =cut
                   3835: 
                   3836: sub source_copyrightids {
                   3837:     return sort(keys(%scprtag));
                   3838: }
                   3839: 
                   3840: =pod
                   3841: 
1.648     raeburn  3842: =item * &source_copyrightdescription() 
1.192     taceyjo1 3843: 
                   3844: returns description of a specified source copyright id
                   3845: 
                   3846: =cut
                   3847: 
                   3848: sub source_copyrightdescription {
                   3849:     return &mt($scprtag{shift(@_)});
                   3850: }
1.112     bowersj2 3851: 
                   3852: =pod
                   3853: 
1.648     raeburn  3854: =item * &filecategories() 
1.112     bowersj2 3855: 
                   3856: returns list of all file categories
                   3857: 
                   3858: =cut
                   3859: 
                   3860: sub filecategories {
                   3861:     return sort(keys(%category_extensions));
                   3862: }
                   3863: 
                   3864: =pod
                   3865: 
1.648     raeburn  3866: =item * &filecategorytypes() 
1.112     bowersj2 3867: 
                   3868: returns list of file types belonging to a given file
                   3869: category
                   3870: 
                   3871: =cut
                   3872: 
                   3873: sub filecategorytypes {
1.356     albertel 3874:     my ($cat) = @_;
                   3875:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3876: }
                   3877: 
                   3878: =pod
                   3879: 
1.648     raeburn  3880: =item * &fileembstyle() 
1.112     bowersj2 3881: 
                   3882: returns embedding style for a specified file type
                   3883: 
                   3884: =cut
                   3885: 
                   3886: sub fileembstyle {
                   3887:     return $fe{lc(shift(@_))};
1.169     www      3888: }
                   3889: 
1.351     www      3890: sub filemimetype {
                   3891:     return $fm{lc(shift(@_))};
                   3892: }
                   3893: 
1.169     www      3894: 
                   3895: sub filecategoryselect {
                   3896:     my ($name,$value)=@_;
1.189     matthew  3897:     return &select_form($value,$name,
1.970     raeburn  3898:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3899: }
                   3900: 
                   3901: =pod
                   3902: 
1.648     raeburn  3903: =item * &filedescription() 
1.112     bowersj2 3904: 
                   3905: returns description for a specified file type
                   3906: 
                   3907: =cut
                   3908: 
                   3909: sub filedescription {
1.188     matthew  3910:     my $file_description = $fd{lc(shift())};
                   3911:     $file_description =~ s:([\[\]]):~$1:g;
                   3912:     return &mt($file_description);
1.112     bowersj2 3913: }
                   3914: 
                   3915: =pod
                   3916: 
1.648     raeburn  3917: =item * &filedescriptionex() 
1.112     bowersj2 3918: 
                   3919: returns description for a specified file type with
                   3920: extra formatting
                   3921: 
                   3922: =cut
                   3923: 
                   3924: sub filedescriptionex {
                   3925:     my $ex=shift;
1.188     matthew  3926:     my $file_description = $fd{lc($ex)};
                   3927:     $file_description =~ s:([\[\]]):~$1:g;
                   3928:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3929: }
                   3930: 
                   3931: # End of .tab access
                   3932: =pod
                   3933: 
                   3934: =back
                   3935: 
                   3936: =cut
                   3937: 
                   3938: # ------------------------------------------------------------------ File Types
                   3939: sub fileextensions {
                   3940:     return sort(keys(%fe));
                   3941: }
                   3942: 
1.97      www      3943: # ----------------------------------------------------------- Display Languages
                   3944: # returns a hash with all desired display languages
                   3945: #
                   3946: 
                   3947: sub display_languages {
                   3948:     my %languages=();
1.695     raeburn  3949:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3950: 	$languages{$lang}=1;
1.97      www      3951:     }
                   3952:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3953:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3954: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3955: 	    $languages{$lang}=1;
1.97      www      3956:         }
                   3957:     }
                   3958:     return %languages;
1.14      harris41 3959: }
                   3960: 
1.582     albertel 3961: sub languages {
                   3962:     my ($possible_langs) = @_;
1.695     raeburn  3963:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3964:     if (!ref($possible_langs)) {
                   3965: 	if( wantarray ) {
                   3966: 	    return @preferred_langs;
                   3967: 	} else {
                   3968: 	    return $preferred_langs[0];
                   3969: 	}
                   3970:     }
                   3971:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3972:     my @preferred_possibilities;
                   3973:     foreach my $preferred_lang (@preferred_langs) {
                   3974: 	if (exists($possibilities{$preferred_lang})) {
                   3975: 	    push(@preferred_possibilities, $preferred_lang);
                   3976: 	}
                   3977:     }
                   3978:     if( wantarray ) {
                   3979: 	return @preferred_possibilities;
                   3980:     }
                   3981:     return $preferred_possibilities[0];
                   3982: }
                   3983: 
1.742     raeburn  3984: sub user_lang {
                   3985:     my ($touname,$toudom,$fromcid) = @_;
                   3986:     my @userlangs;
                   3987:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3988:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3989:                     $env{'course.'.$fromcid.'.languages'}));
                   3990:     } else {
                   3991:         my %langhash = &getlangs($touname,$toudom);
                   3992:         if ($langhash{'languages'} ne '') {
                   3993:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3994:         } else {
                   3995:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3996:             if ($domdefs{'lang_def'} ne '') {
                   3997:                 @userlangs = ($domdefs{'lang_def'});
                   3998:             }
                   3999:         }
                   4000:     }
                   4001:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4002:     my $user_lh = Apache::localize->get_handle(@languages);
                   4003:     return $user_lh;
                   4004: }
                   4005: 
                   4006: 
1.112     bowersj2 4007: ###############################################################
                   4008: ##               Student Answer Attempts                     ##
                   4009: ###############################################################
                   4010: 
                   4011: =pod
                   4012: 
                   4013: =head1 Alternate Problem Views
                   4014: 
                   4015: =over 4
                   4016: 
1.648     raeburn  4017: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199    raeburn  4018:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4019: 
                   4020: Return string with previous attempt on problem. Arguments:
                   4021: 
                   4022: =over 4
                   4023: 
                   4024: =item * $symb: Problem, including path
                   4025: 
                   4026: =item * $username: username of the desired student
                   4027: 
                   4028: =item * $domain: domain of the desired student
1.14      harris41 4029: 
1.112     bowersj2 4030: =item * $course: Course ID
1.14      harris41 4031: 
1.112     bowersj2 4032: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4033:     something
1.14      harris41 4034: 
1.112     bowersj2 4035: =item * $regexp: if string matches this regexp, the string will be
                   4036:     sent to $gradesub
1.14      harris41 4037: 
1.112     bowersj2 4038: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4039: 
1.1199    raeburn  4040: =item * $usec: section of the desired student
                   4041: 
                   4042: =item * $identifier: counter for student (multiple students one problem) or 
                   4043:     problem (one student; whole sequence).
                   4044: 
1.112     bowersj2 4045: =back
1.14      harris41 4046: 
1.112     bowersj2 4047: The output string is a table containing all desired attempts, if any.
1.16      harris41 4048: 
1.112     bowersj2 4049: =cut
1.1       albertel 4050: 
                   4051: sub get_previous_attempt {
1.1199    raeburn  4052:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4053:   my $prevattempts='';
1.43      ng       4054:   no strict 'refs';
1.1       albertel 4055:   if ($symb) {
1.3       albertel 4056:     my (%returnhash)=
                   4057:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4058:     if ($returnhash{'version'}) {
                   4059:       my %lasthash=();
                   4060:       my $version;
                   4061:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212    raeburn  4062:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4063:             if ($key =~ /\.rawrndseed$/) {
                   4064:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4065:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4066:             } else {
                   4067:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4068:             }
1.19      harris41 4069:         }
1.1       albertel 4070:       }
1.596     albertel 4071:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4072:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1199    raeburn  4073:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4074:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4075:       foreach my $key (sort(keys(%lasthash))) {
                   4076: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4077: 	if ($#parts > 0) {
1.31      albertel 4078: 	  my $data=$parts[-1];
1.989     raeburn  4079:           next if ($data eq 'foilorder');
1.31      albertel 4080: 	  pop(@parts);
1.1010    www      4081:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4082:           if ($data eq 'type') {
                   4083:               unless ($showsurv) {
                   4084:                   my $id = join(',',@parts);
                   4085:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4086:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4087:                       $lasthidden{$ign.'.'.$id} = 1;
                   4088:                   }
1.945     raeburn  4089:               }
1.1199    raeburn  4090:               if ($identifier ne '') {
                   4091:                   my $id = join(',',@parts);
                   4092:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4093:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4094:                       $hidestatus{$ign.'.'.$id} = 1;
                   4095:                   }
                   4096:               }
                   4097:           } elsif ($data eq 'regrader') {
                   4098:               if (($identifier ne '') && (@parts)) {
1.1200    raeburn  4099:                   my $id = join(',',@parts);
                   4100:                   $regraded{$ign.'.'.$id} = 1;
1.1199    raeburn  4101:               }
1.1010    www      4102:           } 
1.31      albertel 4103: 	} else {
1.41      ng       4104: 	  if ($#parts == 0) {
                   4105: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4106: 	  } else {
                   4107: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4108: 	  }
1.31      albertel 4109: 	}
1.16      harris41 4110:       }
1.596     albertel 4111:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4112:       if ($getattempt eq '') {
1.1199    raeburn  4113:         my (%solved,%resets,%probstatus);
1.1200    raeburn  4114:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4115:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4116:                 foreach my $id (keys(%regraded)) {
                   4117:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4118:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4119:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4120:                         push(@{$resets{$id}},$version);
1.1199    raeburn  4121:                     }
                   4122:                 }
                   4123:             }
1.1200    raeburn  4124:         }
                   4125: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199    raeburn  4126:             my (@hidden,@unsolved);
1.945     raeburn  4127:             if (%typeparts) {
                   4128:                 foreach my $id (keys(%typeparts)) {
1.1199    raeburn  4129:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                   4130:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4131:                         push(@hidden,$id);
1.1199    raeburn  4132:                     } elsif ($identifier ne '') {
                   4133:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4134:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4135:                                 ($hidestatus{$id})) {
1.1200    raeburn  4136:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199    raeburn  4137:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4138:                                 push(@{$solved{$id}},$version);
                   4139:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4140:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4141:                                 my $skip;
                   4142:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4143:                                     foreach my $reset (@{$resets{$id}}) {
                   4144:                                         if ($reset > $solved{$id}[-1]) {
                   4145:                                             $skip=1;
                   4146:                                             last;
                   4147:                                         }
                   4148:                                     }
                   4149:                                 }
                   4150:                                 unless ($skip) {
                   4151:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4152:                                     push(@unsolved,$partslist);
                   4153:                                 }
                   4154:                             }
                   4155:                         }
1.945     raeburn  4156:                     }
                   4157:                 }
                   4158:             }
                   4159:             $prevattempts.=&start_data_table_row().
1.1199    raeburn  4160:                            '<td>'.&mt('Transaction [_1]',$version);
                   4161:             if (@unsolved) {
                   4162:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4163:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4164:                                  &mt('Hide').'</label></span>';
                   4165:             }
                   4166:             $prevattempts .= '</td>';
1.945     raeburn  4167:             if (@hidden) {
                   4168:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4169:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4170:                     my $hide;
                   4171:                     foreach my $id (@hidden) {
                   4172:                         if ($key =~ /^\Q$id\E/) {
                   4173:                             $hide = 1;
                   4174:                             last;
                   4175:                         }
                   4176:                     }
                   4177:                     if ($hide) {
                   4178:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4179:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4180:                             my $value = &format_previous_attempt_value($key,
                   4181:                                              $returnhash{$version.':'.$key});
1.1173    kruse    4182:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4183:                         } else {
                   4184:                             $prevattempts.='<td>&nbsp;</td>';
                   4185:                         }
                   4186:                     } else {
                   4187:                         if ($key =~ /\./) {
1.1212    raeburn  4188:                             my $value = $returnhash{$version.':'.$key};
                   4189:                             if ($key =~ /\.rndseed$/) {
                   4190:                                 my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4191:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4192:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4193:                                 }
                   4194:                             }
                   4195:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4196:                                            '&nbsp;</td>';
1.945     raeburn  4197:                         } else {
                   4198:                             $prevattempts.='<td>&nbsp;</td>';
                   4199:                         }
                   4200:                     }
                   4201:                 }
                   4202:             } else {
                   4203: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4204:                     next if ($key =~ /\.foilorder$/);
1.1212    raeburn  4205:                     my $value = $returnhash{$version.':'.$key};
                   4206:                     if ($key =~ /\.rndseed$/) {
                   4207:                         my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4208:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4209:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4210:                         }
                   4211:                     }
                   4212:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4213:                                    '&nbsp;</td>';
1.945     raeburn  4214: 	        }
                   4215:             }
                   4216: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4217: 	 }
1.1       albertel 4218:       }
1.945     raeburn  4219:       my @currhidden = keys(%lasthidden);
1.596     albertel 4220:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4221:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4222:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4223:           if (%typeparts) {
                   4224:               my $hidden;
                   4225:               foreach my $id (@currhidden) {
                   4226:                   if ($key =~ /^\Q$id\E/) {
                   4227:                       $hidden = 1;
                   4228:                       last;
                   4229:                   }
                   4230:               }
                   4231:               if ($hidden) {
                   4232:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4233:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4234:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4235:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4236:                           $value = &$gradesub($value);
                   4237:                       }
1.1173    kruse    4238:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  4239:                   } else {
                   4240:                       $prevattempts.='<td>&nbsp;</td>';
                   4241:                   }
                   4242:               } else {
                   4243:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4244:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4245:                       $value = &$gradesub($value);
                   4246:                   }
1.1173    kruse    4247:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4248:               }
                   4249:           } else {
                   4250: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4251: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4252:                   $value = &$gradesub($value);
                   4253:               }
1.1173    kruse    4254: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4255:           }
1.16      harris41 4256:       }
1.596     albertel 4257:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4258:     } else {
1.596     albertel 4259:       $prevattempts=
                   4260: 	  &start_data_table().&start_data_table_row().
                   4261: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   4262: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4263:     }
                   4264:   } else {
1.596     albertel 4265:     $prevattempts=
                   4266: 	  &start_data_table().&start_data_table_row().
                   4267: 	  '<td>'.&mt('No data.').'</td>'.
                   4268: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4269:   }
1.10      albertel 4270: }
                   4271: 
1.581     albertel 4272: sub format_previous_attempt_value {
                   4273:     my ($key,$value) = @_;
1.1011    www      4274:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    4275:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 4276:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    4277:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  4278:     } elsif ($key =~ /answerstring$/) {
                   4279:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    4280:         my @answer = %answers;
                   4281:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  4282:         my @anskeys = sort(keys(%answers));
                   4283:         if (@anskeys == 1) {
                   4284:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4285:             if ($answer =~ m{\0}) {
                   4286:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4287:             }
                   4288:             my $tag_internal_answer_name = 'INTERNAL';
                   4289:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4290:                 $value = $answer; 
                   4291:             } else {
                   4292:                 $value = $anskeys[0].'='.$answer;
                   4293:             }
                   4294:         } else {
                   4295:             foreach my $ans (@anskeys) {
                   4296:                 my $answer = $answers{$ans};
1.1001    raeburn  4297:                 if ($answer =~ m{\0}) {
                   4298:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4299:                 }
                   4300:                 $value .=  $ans.'='.$answer.'<br />';;
                   4301:             } 
                   4302:         }
1.581     albertel 4303:     } else {
1.1173    kruse    4304:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 4305:     }
                   4306:     return $value;
                   4307: }
                   4308: 
                   4309: 
1.107     albertel 4310: sub relative_to_absolute {
                   4311:     my ($url,$output)=@_;
                   4312:     my $parser=HTML::TokeParser->new(\$output);
                   4313:     my $token;
                   4314:     my $thisdir=$url;
                   4315:     my @rlinks=();
                   4316:     while ($token=$parser->get_token) {
                   4317: 	if ($token->[0] eq 'S') {
                   4318: 	    if ($token->[1] eq 'a') {
                   4319: 		if ($token->[2]->{'href'}) {
                   4320: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4321: 		}
                   4322: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4323: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4324: 	    } elsif ($token->[1] eq 'base') {
                   4325: 		$thisdir=$token->[2]->{'href'};
                   4326: 	    }
                   4327: 	}
                   4328:     }
                   4329:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4330:     foreach my $link (@rlinks) {
1.726     raeburn  4331: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4332: 		($link=~/^\//) ||
                   4333: 		($link=~/^javascript:/i) ||
                   4334: 		($link=~/^mailto:/i) ||
                   4335: 		($link=~/^\#/)) {
                   4336: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4337: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4338: 	}
                   4339:     }
                   4340: # -------------------------------------------------- Deal with Applet codebases
                   4341:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4342:     return $output;
                   4343: }
                   4344: 
1.112     bowersj2 4345: =pod
                   4346: 
1.648     raeburn  4347: =item * &get_student_view()
1.112     bowersj2 4348: 
                   4349: show a snapshot of what student was looking at
                   4350: 
                   4351: =cut
                   4352: 
1.10      albertel 4353: sub get_student_view {
1.186     albertel 4354:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4355:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4356:   my (%form);
1.10      albertel 4357:   my @elements=('symb','courseid','domain','username');
                   4358:   foreach my $element (@elements) {
1.186     albertel 4359:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4360:   }
1.186     albertel 4361:   if (defined($moreenv)) {
                   4362:       %form=(%form,%{$moreenv});
                   4363:   }
1.236     albertel 4364:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4365:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4366:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4367:   $userview=~s/\<body[^\>]*\>//gi;
                   4368:   $userview=~s/\<\/body\>//gi;
                   4369:   $userview=~s/\<html\>//gi;
                   4370:   $userview=~s/\<\/html\>//gi;
                   4371:   $userview=~s/\<head\>//gi;
                   4372:   $userview=~s/\<\/head\>//gi;
                   4373:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4374:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4375:   if (wantarray) {
                   4376:      return ($userview,$response);
                   4377:   } else {
                   4378:      return $userview;
                   4379:   }
                   4380: }
                   4381: 
                   4382: sub get_student_view_with_retries {
                   4383:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4384: 
                   4385:     my $ok = 0;                 # True if we got a good response.
                   4386:     my $content;
                   4387:     my $response;
                   4388: 
                   4389:     # Try to get the student_view done. within the retries count:
                   4390:     
                   4391:     do {
                   4392:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4393:          $ok      = $response->is_success;
                   4394:          if (!$ok) {
                   4395:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4396:          }
                   4397:          $retries--;
                   4398:     } while (!$ok && ($retries > 0));
                   4399:     
                   4400:     if (!$ok) {
                   4401:        $content = '';          # On error return an empty content.
                   4402:     }
1.651     www      4403:     if (wantarray) {
                   4404:        return ($content, $response);
                   4405:     } else {
                   4406:        return $content;
                   4407:     }
1.11      albertel 4408: }
                   4409: 
1.112     bowersj2 4410: =pod
                   4411: 
1.648     raeburn  4412: =item * &get_student_answers() 
1.112     bowersj2 4413: 
                   4414: show a snapshot of how student was answering problem
                   4415: 
                   4416: =cut
                   4417: 
1.11      albertel 4418: sub get_student_answers {
1.100     sakharuk 4419:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4420:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4421:   my (%moreenv);
1.11      albertel 4422:   my @elements=('symb','courseid','domain','username');
                   4423:   foreach my $element (@elements) {
1.186     albertel 4424:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4425:   }
1.186     albertel 4426:   $moreenv{'grade_target'}='answer';
                   4427:   %moreenv=(%form,%moreenv);
1.497     raeburn  4428:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4429:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4430:   return $userview;
1.1       albertel 4431: }
1.116     albertel 4432: 
                   4433: =pod
                   4434: 
                   4435: =item * &submlink()
                   4436: 
1.242     albertel 4437: Inputs: $text $uname $udom $symb $target
1.116     albertel 4438: 
                   4439: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4440: 
                   4441: =cut
                   4442: 
                   4443: ###############################################
                   4444: sub submlink {
1.242     albertel 4445:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4446:     if (!($uname && $udom)) {
                   4447: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4448: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4449: 	if (!$symb) { $symb=$cursymb; }
                   4450:     }
1.254     matthew  4451:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4452:     $symb=&escape($symb);
1.960     bisitz   4453:     if ($target) { $target=" target=\"$target\""; }
                   4454:     return
                   4455:         '<a href="/adm/grades?command=submission'.
                   4456:         '&amp;symb='.$symb.
                   4457:         '&amp;student='.$uname.
                   4458:         '&amp;userdom='.$udom.'"'.
                   4459:         $target.'>'.$text.'</a>';
1.242     albertel 4460: }
                   4461: ##############################################
                   4462: 
                   4463: =pod
                   4464: 
                   4465: =item * &pgrdlink()
                   4466: 
                   4467: Inputs: $text $uname $udom $symb $target
                   4468: 
                   4469: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4470: 
                   4471: =cut
                   4472: 
                   4473: ###############################################
                   4474: sub pgrdlink {
                   4475:     my $link=&submlink(@_);
                   4476:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4477:     return $link;
                   4478: }
                   4479: ##############################################
                   4480: 
                   4481: =pod
                   4482: 
                   4483: =item * &pprmlink()
                   4484: 
                   4485: Inputs: $text $uname $udom $symb $target
                   4486: 
                   4487: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4488: student and a specific resource
1.242     albertel 4489: 
                   4490: =cut
                   4491: 
                   4492: ###############################################
                   4493: sub pprmlink {
                   4494:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4495:     if (!($uname && $udom)) {
                   4496: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4497: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4498: 	if (!$symb) { $symb=$cursymb; }
                   4499:     }
1.254     matthew  4500:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4501:     $symb=&escape($symb);
1.242     albertel 4502:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4503:     return '<a href="/adm/parmset?command=set&amp;'.
                   4504: 	'symb='.$symb.'&amp;uname='.$uname.
                   4505: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4506: }
                   4507: ##############################################
1.37      matthew  4508: 
1.112     bowersj2 4509: =pod
                   4510: 
                   4511: =back
                   4512: 
                   4513: =cut
                   4514: 
1.37      matthew  4515: ###############################################
1.51      www      4516: 
                   4517: 
                   4518: sub timehash {
1.687     raeburn  4519:     my ($thistime) = @_;
                   4520:     my $timezone = &Apache::lonlocal::gettimezone();
                   4521:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4522:                      ->set_time_zone($timezone);
                   4523:     my $wday = $dt->day_of_week();
                   4524:     if ($wday == 7) { $wday = 0; }
                   4525:     return ( 'second' => $dt->second(),
                   4526:              'minute' => $dt->minute(),
                   4527:              'hour'   => $dt->hour(),
                   4528:              'day'     => $dt->day_of_month(),
                   4529:              'month'   => $dt->month(),
                   4530:              'year'    => $dt->year(),
                   4531:              'weekday' => $wday,
                   4532:              'dayyear' => $dt->day_of_year(),
                   4533:              'dlsav'   => $dt->is_dst() );
1.51      www      4534: }
                   4535: 
1.370     www      4536: sub utc_string {
                   4537:     my ($date)=@_;
1.371     www      4538:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4539: }
                   4540: 
1.51      www      4541: sub maketime {
                   4542:     my %th=@_;
1.687     raeburn  4543:     my ($epoch_time,$timezone,$dt);
                   4544:     $timezone = &Apache::lonlocal::gettimezone();
                   4545:     eval {
                   4546:         $dt = DateTime->new( year   => $th{'year'},
                   4547:                              month  => $th{'month'},
                   4548:                              day    => $th{'day'},
                   4549:                              hour   => $th{'hour'},
                   4550:                              minute => $th{'minute'},
                   4551:                              second => $th{'second'},
                   4552:                              time_zone => $timezone,
                   4553:                          );
                   4554:     };
                   4555:     if (!$@) {
                   4556:         $epoch_time = $dt->epoch;
                   4557:         if ($epoch_time) {
                   4558:             return $epoch_time;
                   4559:         }
                   4560:     }
1.51      www      4561:     return POSIX::mktime(
                   4562:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4563:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4564: }
                   4565: 
                   4566: #########################################
1.51      www      4567: 
                   4568: sub findallcourses {
1.482     raeburn  4569:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4570:     my %roles;
                   4571:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4572:     my %courses;
1.51      www      4573:     my $now=time;
1.482     raeburn  4574:     if (!defined($uname)) {
                   4575:         $uname = $env{'user.name'};
                   4576:     }
                   4577:     if (!defined($udom)) {
                   4578:         $udom = $env{'user.domain'};
                   4579:     }
                   4580:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4581:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4582:         if (!%roles) {
                   4583:             %roles = (
                   4584:                        cc => 1,
1.907     raeburn  4585:                        co => 1,
1.482     raeburn  4586:                        in => 1,
                   4587:                        ep => 1,
                   4588:                        ta => 1,
                   4589:                        cr => 1,
                   4590:                        st => 1,
                   4591:              );
                   4592:         }
                   4593:         foreach my $entry (keys(%roleshash)) {
                   4594:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4595:             if ($trole =~ /^cr/) { 
                   4596:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4597:             } else {
                   4598:                 next if (!exists($roles{$trole}));
                   4599:             }
                   4600:             if ($tend) {
                   4601:                 next if ($tend < $now);
                   4602:             }
                   4603:             if ($tstart) {
                   4604:                 next if ($tstart > $now);
                   4605:             }
1.1058    raeburn  4606:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4607:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4608:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4609:             if ($secpart eq '') {
                   4610:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4611:                 $sec = 'none';
1.1058    raeburn  4612:                 $value .= $cnum.'/';
1.482     raeburn  4613:             } else {
                   4614:                 $cnum = $cnumpart;
                   4615:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4616:                 $value .= $cnum.'/'.$sec;
                   4617:             }
                   4618:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4619:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4620:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4621:                 }
                   4622:             } else {
                   4623:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4624:             }
1.482     raeburn  4625:         }
                   4626:     } else {
                   4627:         foreach my $key (keys(%env)) {
1.483     albertel 4628: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4629:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4630: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4631: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4632: 	        next if (%roles && !exists($roles{$role}));
                   4633: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4634:                 my $active=1;
                   4635:                 if ($starttime) {
                   4636: 		    if ($now<$starttime) { $active=0; }
                   4637:                 }
                   4638:                 if ($endtime) {
                   4639:                     if ($now>$endtime) { $active=0; }
                   4640:                 }
                   4641:                 if ($active) {
1.1058    raeburn  4642:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4643:                     if ($sec eq '') {
                   4644:                         $sec = 'none';
1.1058    raeburn  4645:                     } else {
                   4646:                         $value .= $sec;
                   4647:                     }
                   4648:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4649:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4650:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4651:                         }
                   4652:                     } else {
                   4653:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4654:                     }
1.474     raeburn  4655:                 }
                   4656:             }
1.51      www      4657:         }
                   4658:     }
1.474     raeburn  4659:     return %courses;
1.51      www      4660: }
1.37      matthew  4661: 
1.54      www      4662: ###############################################
1.474     raeburn  4663: 
                   4664: sub blockcheck {
1.1189    raeburn  4665:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4666: 
1.1189    raeburn  4667:     if (defined($udom) && defined($uname)) {
                   4668:         # If uname and udom are for a course, check for blocks in the course.
                   4669:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4670:             my ($startblock,$endblock,$triggerblock) =
                   4671:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4672:             return ($startblock,$endblock,$triggerblock);
                   4673:         }
                   4674:     } else {
1.490     raeburn  4675:         $udom = $env{'user.domain'};
                   4676:         $uname = $env{'user.name'};
                   4677:     }
                   4678: 
1.502     raeburn  4679:     my $startblock = 0;
                   4680:     my $endblock = 0;
1.1062    raeburn  4681:     my $triggerblock = '';
1.482     raeburn  4682:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4683: 
1.490     raeburn  4684:     # If uname is for a user, and activity is course-specific, i.e.,
                   4685:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4686: 
1.490     raeburn  4687:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189    raeburn  4688:          $activity eq 'groups' || $activity eq 'printout') &&
                   4689:         ($env{'request.course.id'})) {
1.490     raeburn  4690:         foreach my $key (keys(%live_courses)) {
                   4691:             if ($key ne $env{'request.course.id'}) {
                   4692:                 delete($live_courses{$key});
                   4693:             }
                   4694:         }
                   4695:     }
                   4696: 
                   4697:     my $otheruser = 0;
                   4698:     my %own_courses;
                   4699:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4700:         # Resource belongs to user other than current user.
                   4701:         $otheruser = 1;
                   4702:         # Gather courses for current user
                   4703:         %own_courses = 
                   4704:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4705:     }
                   4706: 
                   4707:     # Gather active course roles - course coordinator, instructor, 
                   4708:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4709: 
                   4710:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4711:         my ($cdom,$cnum);
                   4712:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4713:             $cdom = $env{'course.'.$course.'.domain'};
                   4714:             $cnum = $env{'course.'.$course.'.num'};
                   4715:         } else {
1.490     raeburn  4716:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4717:         }
                   4718:         my $no_ownblock = 0;
                   4719:         my $no_userblock = 0;
1.533     raeburn  4720:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4721:             # Check if current user has 'evb' priv for this
                   4722:             if (defined($own_courses{$course})) {
                   4723:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4724:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4725:                     if ($sec ne 'none') {
                   4726:                         $checkrole .= '/'.$sec;
                   4727:                     }
                   4728:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4729:                         $no_ownblock = 1;
                   4730:                         last;
                   4731:                     }
                   4732:                 }
                   4733:             }
                   4734:             # if they have 'evb' priv and are currently not playing student
                   4735:             next if (($no_ownblock) &&
                   4736:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4737:         }
1.474     raeburn  4738:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4739:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4740:             if ($sec ne 'none') {
1.482     raeburn  4741:                 $checkrole .= '/'.$sec;
1.474     raeburn  4742:             }
1.490     raeburn  4743:             if ($otheruser) {
                   4744:                 # Resource belongs to user other than current user.
                   4745:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4746:                 my (%allroles,%userroles);
                   4747:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4748:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4749:                         my ($trole,$tdom,$tnum,$tsec);
                   4750:                         if ($entry =~ /^cr/) {
                   4751:                             ($trole,$tdom,$tnum,$tsec) = 
                   4752:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4753:                         } else {
                   4754:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4755:                         }
                   4756:                         my ($spec,$area,$trest);
                   4757:                         $area = '/'.$tdom.'/'.$tnum;
                   4758:                         $trest = $tnum;
                   4759:                         if ($tsec ne '') {
                   4760:                             $area .= '/'.$tsec;
                   4761:                             $trest .= '/'.$tsec;
                   4762:                         }
                   4763:                         $spec = $trole.'.'.$area;
                   4764:                         if ($trole =~ /^cr/) {
                   4765:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4766:                                                               $tdom,$spec,$trest,$area);
                   4767:                         } else {
                   4768:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4769:                                                                 $tdom,$spec,$trest,$area);
                   4770:                         }
                   4771:                     }
                   4772:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4773:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4774:                         if ($1) {
                   4775:                             $no_userblock = 1;
                   4776:                             last;
                   4777:                         }
1.486     raeburn  4778:                     }
                   4779:                 }
1.490     raeburn  4780:             } else {
                   4781:                 # Resource belongs to current user
                   4782:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4783:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4784:                     $no_ownblock = 1;
                   4785:                     last;
                   4786:                 }
1.474     raeburn  4787:             }
                   4788:         }
                   4789:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4790:         next if (($no_ownblock) &&
1.491     albertel 4791:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4792:         next if ($no_userblock);
1.474     raeburn  4793: 
1.866     kalberla 4794:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4795:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4796:         
1.1062    raeburn  4797:         my ($start,$end,$trigger) = 
                   4798:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4799:         if (($start != 0) && 
                   4800:             (($startblock == 0) || ($startblock > $start))) {
                   4801:             $startblock = $start;
1.1062    raeburn  4802:             if ($trigger ne '') {
                   4803:                 $triggerblock = $trigger;
                   4804:             }
1.502     raeburn  4805:         }
                   4806:         if (($end != 0)  &&
                   4807:             (($endblock == 0) || ($endblock < $end))) {
                   4808:             $endblock = $end;
1.1062    raeburn  4809:             if ($trigger ne '') {
                   4810:                 $triggerblock = $trigger;
                   4811:             }
1.502     raeburn  4812:         }
1.490     raeburn  4813:     }
1.1062    raeburn  4814:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4815: }
                   4816: 
                   4817: sub get_blocks {
1.1062    raeburn  4818:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4819:     my $startblock = 0;
                   4820:     my $endblock = 0;
1.1062    raeburn  4821:     my $triggerblock = '';
1.490     raeburn  4822:     my $course = $cdom.'_'.$cnum;
                   4823:     $setters->{$course} = {};
                   4824:     $setters->{$course}{'staff'} = [];
                   4825:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4826:     $setters->{$course}{'triggers'} = [];
                   4827:     my (@blockers,%triggered);
                   4828:     my $now = time;
                   4829:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4830:     if ($activity eq 'docs') {
                   4831:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4832:         foreach my $block (@blockers) {
                   4833:             if ($block =~ /^firstaccess____(.+)$/) {
                   4834:                 my $item = $1;
                   4835:                 my $type = 'map';
                   4836:                 my $timersymb = $item;
                   4837:                 if ($item eq 'course') {
                   4838:                     $type = 'course';
                   4839:                 } elsif ($item =~ /___\d+___/) {
                   4840:                     $type = 'resource';
                   4841:                 } else {
                   4842:                     $timersymb = &Apache::lonnet::symbread($item);
                   4843:                 }
                   4844:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4845:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4846:                 $triggered{$block} = {
                   4847:                                        start => $start,
                   4848:                                        end   => $end,
                   4849:                                        type  => $type,
                   4850:                                      };
                   4851:             }
                   4852:         }
                   4853:     } else {
                   4854:         foreach my $block (keys(%commblocks)) {
                   4855:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4856:                 my ($start,$end) = ($1,$2);
                   4857:                 if ($start <= time && $end >= time) {
                   4858:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4859:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4860:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4861:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4862:                                     push(@blockers,$block);
                   4863:                                 }
                   4864:                             }
                   4865:                         }
                   4866:                     }
                   4867:                 }
                   4868:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4869:                 my $item = $1;
                   4870:                 my $timersymb = $item; 
                   4871:                 my $type = 'map';
                   4872:                 if ($item eq 'course') {
                   4873:                     $type = 'course';
                   4874:                 } elsif ($item =~ /___\d+___/) {
                   4875:                     $type = 'resource';
                   4876:                 } else {
                   4877:                     $timersymb = &Apache::lonnet::symbread($item);
                   4878:                 }
                   4879:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4880:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4881:                 if ($start && $end) {
                   4882:                     if (($start <= time) && ($end >= time)) {
                   4883:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4884:                             push(@blockers,$block);
                   4885:                             $triggered{$block} = {
                   4886:                                                    start => $start,
                   4887:                                                    end   => $end,
                   4888:                                                    type  => $type,
                   4889:                                                  };
                   4890:                         }
                   4891:                     }
1.490     raeburn  4892:                 }
1.1062    raeburn  4893:             }
                   4894:         }
                   4895:     }
                   4896:     foreach my $blocker (@blockers) {
                   4897:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4898:             &parse_block_record($commblocks{$blocker});
                   4899:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4900:         my ($start,$end,$triggertype);
                   4901:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4902:             ($start,$end) = ($1,$2);
                   4903:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4904:             $start = $triggered{$blocker}{'start'};
                   4905:             $end = $triggered{$blocker}{'end'};
                   4906:             $triggertype = $triggered{$blocker}{'type'};
                   4907:         }
                   4908:         if ($start) {
                   4909:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4910:             if ($triggertype) {
                   4911:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4912:             } else {
                   4913:                 push(@{$$setters{$course}{'triggers'}},0);
                   4914:             }
                   4915:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4916:                 $startblock = $start;
                   4917:                 if ($triggertype) {
                   4918:                     $triggerblock = $blocker;
1.474     raeburn  4919:                 }
                   4920:             }
1.1062    raeburn  4921:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4922:                $endblock = $end;
                   4923:                if ($triggertype) {
                   4924:                    $triggerblock = $blocker;
                   4925:                }
                   4926:             }
1.474     raeburn  4927:         }
                   4928:     }
1.1062    raeburn  4929:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4930: }
                   4931: 
                   4932: sub parse_block_record {
                   4933:     my ($record) = @_;
                   4934:     my ($setuname,$setudom,$title,$blocks);
                   4935:     if (ref($record) eq 'HASH') {
                   4936:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4937:         $title = &unescape($record->{'event'});
                   4938:         $blocks = $record->{'blocks'};
                   4939:     } else {
                   4940:         my @data = split(/:/,$record,3);
                   4941:         if (scalar(@data) eq 2) {
                   4942:             $title = $data[1];
                   4943:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4944:         } else {
                   4945:             ($setuname,$setudom,$title) = @data;
                   4946:         }
                   4947:         $blocks = { 'com' => 'on' };
                   4948:     }
                   4949:     return ($setuname,$setudom,$title,$blocks);
                   4950: }
                   4951: 
1.854     kalberla 4952: sub blocking_status {
1.1189    raeburn  4953:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4954:     my %setters;
1.890     droeschl 4955: 
1.1061    raeburn  4956: # check for active blocking
1.1062    raeburn  4957:     my ($startblock,$endblock,$triggerblock) = 
1.1189    raeburn  4958:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4959:     my $blocked = 0;
                   4960:     if ($startblock && $endblock) {
                   4961:         $blocked = 1;
                   4962:     }
1.890     droeschl 4963: 
1.1061    raeburn  4964: # caller just wants to know whether a block is active
                   4965:     if (!wantarray) { return $blocked; }
                   4966: 
                   4967: # build a link to a popup window containing the details
                   4968:     my $querystring  = "?activity=$activity";
                   4969: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232    raeburn  4970:     if (($activity eq 'port') || ($activity eq 'passwd')) {
                   4971:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
                   4972:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  4973:     } elsif ($activity eq 'docs') {
                   4974:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4975:     }
1.1061    raeburn  4976: 
                   4977:     my $output .= <<'END_MYBLOCK';
                   4978: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4979:     var options = "width=" + w + ",height=" + h + ",";
                   4980:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4981:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4982:     var newWin = window.open(url, wdwName, options);
                   4983:     newWin.focus();
                   4984: }
1.890     droeschl 4985: END_MYBLOCK
1.854     kalberla 4986: 
1.1061    raeburn  4987:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4988:   
1.1061    raeburn  4989:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4990:     my $text = &mt('Communication Blocked');
1.1217    raeburn  4991:     my $class = 'LC_comblock';
1.1062    raeburn  4992:     if ($activity eq 'docs') {
                   4993:         $text = &mt('Content Access Blocked');
1.1217    raeburn  4994:         $class = '';
1.1063    raeburn  4995:     } elsif ($activity eq 'printout') {
                   4996:         $text = &mt('Printing Blocked');
1.1232    raeburn  4997:     } elsif ($activity eq 'passwd') {
                   4998:         $text = &mt('Password Changing Blocked');
1.1062    raeburn  4999:     }
1.1061    raeburn  5000:     $output .= <<"END_BLOCK";
1.1217    raeburn  5001: <div class='$class'>
1.869     kalberla 5002:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5003:   title='$text'>
                   5004:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5005:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5006:   title='$text'>$text</a>
1.867     kalberla 5007: </div>
                   5008: 
                   5009: END_BLOCK
1.474     raeburn  5010: 
1.1061    raeburn  5011:     return ($blocked, $output);
1.854     kalberla 5012: }
1.490     raeburn  5013: 
1.60      matthew  5014: ###############################################
                   5015: 
1.682     raeburn  5016: sub check_ip_acc {
1.1201    raeburn  5017:     my ($acc,$clientip)=@_;
1.682     raeburn  5018:     &Apache::lonxml::debug("acc is $acc");
                   5019:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5020:         return 1;
                   5021:     }
1.1219    raeburn  5022:     my $allowed;
1.1201    raeburn  5023:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682     raeburn  5024: 
                   5025:     my $name;
1.1219    raeburn  5026:     my %access = (
                   5027:                      allowfrom => 1,
                   5028:                      denyfrom  => 0,
                   5029:                  );
                   5030:     my @allows;
                   5031:     my @denies;
                   5032:     foreach my $item (split(',',$acc)) {
                   5033:         $item =~ s/^\s*//;
                   5034:         $item =~ s/\s*$//;
                   5035:         my $pattern;
                   5036:         if ($item =~ /^\!(.+)$/) {
                   5037:             push(@denies,$1);
                   5038:         } else {
                   5039:             push(@allows,$item);
                   5040:         }
                   5041:    }
                   5042:    my $numdenies = scalar(@denies);
                   5043:    my $numallows = scalar(@allows);
                   5044:    my $count = 0;
                   5045:    foreach my $pattern (@denies,@allows) {
                   5046:         $count ++; 
                   5047:         my $acctype = 'allowfrom';
                   5048:         if ($count <= $numdenies) {
                   5049:             $acctype = 'denyfrom';
                   5050:         }
1.682     raeburn  5051:         if ($pattern =~ /\*$/) {
                   5052:             #35.8.*
                   5053:             $pattern=~s/\*//;
1.1219    raeburn  5054:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5055:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5056:             #35.8.3.[34-56]
                   5057:             my $low=$2;
                   5058:             my $high=$3;
                   5059:             $pattern=$1;
                   5060:             if ($ip =~ /^\Q$pattern\E/) {
                   5061:                 my $last=(split(/\./,$ip))[3];
1.1219    raeburn  5062:                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  5063:             }
                   5064:         } elsif ($pattern =~ /^\*/) {
                   5065:             #*.msu.edu
                   5066:             $pattern=~s/\*//;
                   5067:             if (!defined($name)) {
                   5068:                 use Socket;
                   5069:                 my $netaddr=inet_aton($ip);
                   5070:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5071:             }
1.1219    raeburn  5072:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  5073:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5074:             #127.0.0.1
1.1219    raeburn  5075:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5076:         } else {
                   5077:             #some.name.com
                   5078:             if (!defined($name)) {
                   5079:                 use Socket;
                   5080:                 my $netaddr=inet_aton($ip);
                   5081:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5082:             }
1.1219    raeburn  5083:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   5084:         }
                   5085:         if ($allowed =~ /^(0|1)$/) { last; }
                   5086:     }
                   5087:     if ($allowed eq '') {
                   5088:         if ($numdenies && !$numallows) {
                   5089:             $allowed = 1;
                   5090:         } else {
                   5091:             $allowed = 0;
1.682     raeburn  5092:         }
                   5093:     }
                   5094:     return $allowed;
                   5095: }
                   5096: 
                   5097: ###############################################
                   5098: 
1.60      matthew  5099: =pod
                   5100: 
1.112     bowersj2 5101: =head1 Domain Template Functions
                   5102: 
                   5103: =over 4
                   5104: 
                   5105: =item * &determinedomain()
1.60      matthew  5106: 
                   5107: Inputs: $domain (usually will be undef)
                   5108: 
1.63      www      5109: Returns: Determines which domain should be used for designs
1.60      matthew  5110: 
                   5111: =cut
1.54      www      5112: 
1.60      matthew  5113: ###############################################
1.63      www      5114: sub determinedomain {
                   5115:     my $domain=shift;
1.531     albertel 5116:     if (! $domain) {
1.60      matthew  5117:         # Determine domain if we have not been given one
1.893     raeburn  5118:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5119:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5120:         if ($env{'request.role.domain'}) { 
                   5121:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5122:         }
                   5123:     }
1.63      www      5124:     return $domain;
                   5125: }
                   5126: ###############################################
1.517     raeburn  5127: 
1.518     albertel 5128: sub devalidate_domconfig_cache {
                   5129:     my ($udom)=@_;
                   5130:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5131: }
                   5132: 
                   5133: # ---------------------- Get domain configuration for a domain
                   5134: sub get_domainconf {
                   5135:     my ($udom) = @_;
                   5136:     my $cachetime=1800;
                   5137:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5138:     if (defined($cached)) { return %{$result}; }
                   5139: 
                   5140:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5141: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5142:     my (%designhash,%legacy);
1.518     albertel 5143:     if (keys(%domconfig) > 0) {
                   5144:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5145:             if (keys(%{$domconfig{'login'}})) {
                   5146:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5147:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208    raeburn  5148:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5149:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5150:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5151:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5152:                                         if ($key eq 'loginvia') {
                   5153:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5154:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5155:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5156:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5157: 
                   5158:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5159:                                                 } else {
                   5160:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5161:                                                 }
1.948     raeburn  5162:                                             }
1.1208    raeburn  5163:                                         } elsif ($key eq 'headtag') {
                   5164:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5165:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5166:                                             }
1.946     raeburn  5167:                                         }
1.1208    raeburn  5168:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5169:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5170:                                         }
1.946     raeburn  5171:                                     }
                   5172:                                 }
                   5173:                             }
                   5174:                         } else {
                   5175:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5176:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5177:                                     $domconfig{'login'}{$key}{$img};
                   5178:                             }
1.699     raeburn  5179:                         }
                   5180:                     } else {
                   5181:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5182:                     }
1.632     raeburn  5183:                 }
                   5184:             } else {
                   5185:                 $legacy{'login'} = 1;
1.518     albertel 5186:             }
1.632     raeburn  5187:         } else {
                   5188:             $legacy{'login'} = 1;
1.518     albertel 5189:         }
                   5190:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5191:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5192:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5193:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5194:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5195:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5196:                         }
1.518     albertel 5197:                     }
                   5198:                 }
1.632     raeburn  5199:             } else {
                   5200:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5201:             }
1.632     raeburn  5202:         } else {
                   5203:             $legacy{'rolecolors'} = 1;
1.518     albertel 5204:         }
1.948     raeburn  5205:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5206:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5207:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5208:             }
                   5209:         }
1.632     raeburn  5210:         if (keys(%legacy) > 0) {
                   5211:             my %legacyhash = &get_legacy_domconf($udom);
                   5212:             foreach my $item (keys(%legacyhash)) {
                   5213:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5214:                     if ($legacy{'login'}) { 
                   5215:                         $designhash{$item} = $legacyhash{$item};
                   5216:                     }
                   5217:                 } else {
                   5218:                     if ($legacy{'rolecolors'}) {
                   5219:                         $designhash{$item} = $legacyhash{$item};
                   5220:                     }
1.518     albertel 5221:                 }
                   5222:             }
                   5223:         }
1.632     raeburn  5224:     } else {
                   5225:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5226:     }
                   5227:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5228: 				  $cachetime);
                   5229:     return %designhash;
                   5230: }
                   5231: 
1.632     raeburn  5232: sub get_legacy_domconf {
                   5233:     my ($udom) = @_;
                   5234:     my %legacyhash;
                   5235:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5236:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5237:     if (-e $designfile) {
                   5238:         if ( open (my $fh,"<$designfile") ) {
                   5239:             while (my $line = <$fh>) {
                   5240:                 next if ($line =~ /^\#/);
                   5241:                 chomp($line);
                   5242:                 my ($key,$val)=(split(/\=/,$line));
                   5243:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5244:             }
                   5245:             close($fh);
                   5246:         }
                   5247:     }
1.1026    raeburn  5248:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5249:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5250:     }
                   5251:     return %legacyhash;
                   5252: }
                   5253: 
1.63      www      5254: =pod
                   5255: 
1.112     bowersj2 5256: =item * &domainlogo()
1.63      www      5257: 
                   5258: Inputs: $domain (usually will be undef)
                   5259: 
                   5260: Returns: A link to a domain logo, if the domain logo exists.
                   5261: If the domain logo does not exist, a description of the domain.
                   5262: 
                   5263: =cut
1.112     bowersj2 5264: 
1.63      www      5265: ###############################################
                   5266: sub domainlogo {
1.517     raeburn  5267:     my $domain = &determinedomain(shift);
1.518     albertel 5268:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5269:     # See if there is a logo
                   5270:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5271:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5272:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5273: 	    if ($imgsrc =~ m{^/res/}) {
                   5274: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5275: 		&Apache::lonnet::repcopy($local_name);
                   5276: 	    }
                   5277: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  5278:         } 
                   5279:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 5280:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5281:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5282:     } else {
1.60      matthew  5283:         return '';
1.59      www      5284:     }
                   5285: }
1.63      www      5286: ##############################################
                   5287: 
                   5288: =pod
                   5289: 
1.112     bowersj2 5290: =item * &designparm()
1.63      www      5291: 
                   5292: Inputs: $which parameter; $domain (usually will be undef)
                   5293: 
                   5294: Returns: value of designparamter $which
                   5295: 
                   5296: =cut
1.112     bowersj2 5297: 
1.397     albertel 5298: 
1.400     albertel 5299: ##############################################
1.397     albertel 5300: sub designparm {
                   5301:     my ($which,$domain)=@_;
                   5302:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5303:         return $env{'environment.color.'.$which};
1.96      www      5304:     }
1.63      www      5305:     $domain=&determinedomain($domain);
1.1016    raeburn  5306:     my %domdesign;
                   5307:     unless ($domain eq 'public') {
                   5308:         %domdesign = &get_domainconf($domain);
                   5309:     }
1.520     raeburn  5310:     my $output;
1.517     raeburn  5311:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5312:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5313:     } else {
1.520     raeburn  5314:         $output = $defaultdesign{$which};
                   5315:     }
                   5316:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5317:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5318:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5319:             if ($output =~ m{^/res/}) {
                   5320:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5321:                 &Apache::lonnet::repcopy($local_name);
                   5322:             }
1.520     raeburn  5323:             $output = &lonhttpdurl($output);
                   5324:         }
1.63      www      5325:     }
1.520     raeburn  5326:     return $output;
1.63      www      5327: }
1.59      www      5328: 
1.822     bisitz   5329: ##############################################
                   5330: =pod
                   5331: 
1.832     bisitz   5332: =item * &authorspace()
                   5333: 
1.1028    raeburn  5334: Inputs: $url (usually will be undef).
1.832     bisitz   5335: 
1.1132    raeburn  5336: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5337:          directory being viewed (or for which action is being taken). 
                   5338:          If $url is provided, and begins /priv/<domain>/<uname>
                   5339:          the path will be that portion of the $context argument.
                   5340:          Otherwise the path will be for the author space of the current
                   5341:          user when the current role is author, or for that of the 
                   5342:          co-author/assistant co-author space when the current role 
                   5343:          is co-author or assistant co-author.
1.832     bisitz   5344: 
                   5345: =cut
                   5346: 
                   5347: sub authorspace {
1.1028    raeburn  5348:     my ($url) = @_;
                   5349:     if ($url ne '') {
                   5350:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5351:            return $1;
                   5352:         }
                   5353:     }
1.832     bisitz   5354:     my $caname = '';
1.1024    www      5355:     my $cadom = '';
1.1028    raeburn  5356:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5357:         ($cadom,$caname) =
1.832     bisitz   5358:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5359:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5360:         $caname = $env{'user.name'};
1.1024    www      5361:         $cadom = $env{'user.domain'};
1.832     bisitz   5362:     }
1.1028    raeburn  5363:     if (($caname ne '') && ($cadom ne '')) {
                   5364:         return "/priv/$cadom/$caname/";
                   5365:     }
                   5366:     return;
1.832     bisitz   5367: }
                   5368: 
                   5369: ##############################################
                   5370: =pod
                   5371: 
1.822     bisitz   5372: =item * &head_subbox()
                   5373: 
                   5374: Inputs: $content (contains HTML code with page functions, etc.)
                   5375: 
                   5376: Returns: HTML div with $content
                   5377:          To be included in page header
                   5378: 
                   5379: =cut
                   5380: 
                   5381: sub head_subbox {
                   5382:     my ($content)=@_;
                   5383:     my $output =
1.993     raeburn  5384:         '<div class="LC_head_subbox">'
1.822     bisitz   5385:        .$content
                   5386:        .'</div>'
                   5387: }
                   5388: 
                   5389: ##############################################
                   5390: =pod
                   5391: 
                   5392: =item * &CSTR_pageheader()
                   5393: 
1.1026    raeburn  5394: Input: (optional) filename from which breadcrumb trail is built.
                   5395:        In most cases no input as needed, as $env{'request.filename'}
                   5396:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5397: 
                   5398: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5399:          To be included on Authoring Space pages
1.822     bisitz   5400: 
                   5401: =cut
                   5402: 
                   5403: sub CSTR_pageheader {
1.1026    raeburn  5404:     my ($trailfile) = @_;
                   5405:     if ($trailfile eq '') {
                   5406:         $trailfile = $env{'request.filename'};
                   5407:     }
                   5408: 
                   5409: # this is for resources; directories have customtitle, and crumbs
                   5410: # and select recent are created in lonpubdir.pm
                   5411: 
                   5412:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5413:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5414:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5415:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5416:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5417: 
                   5418:     my $parentpath = '';
                   5419:     my $lastitem = '';
                   5420:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5421:         $parentpath = $1;
                   5422:         $lastitem = $2;
                   5423:     } else {
                   5424:         $lastitem = $thisdisfn;
                   5425:     }
1.921     bisitz   5426: 
                   5427:     my $output =
1.822     bisitz   5428:          '<div>'
                   5429:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132    raeburn  5430:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5431:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5432:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5433:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5434: 
                   5435:     if ($lastitem) {
                   5436:         $output .=
                   5437:              '<span class="LC_filename">'
                   5438:             .$lastitem
                   5439:             .'</span>';
                   5440:     }
                   5441:     $output .=
                   5442:          '<br />'
1.822     bisitz   5443:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5444:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5445:         .'</form>'
                   5446:         .&Apache::lonmenu::constspaceform()
                   5447:         .'</div>';
1.921     bisitz   5448: 
                   5449:     return $output;
1.822     bisitz   5450: }
                   5451: 
1.60      matthew  5452: ###############################################
                   5453: ###############################################
                   5454: 
                   5455: =pod
                   5456: 
1.112     bowersj2 5457: =back
                   5458: 
1.549     albertel 5459: =head1 HTML Helpers
1.112     bowersj2 5460: 
                   5461: =over 4
                   5462: 
                   5463: =item * &bodytag()
1.60      matthew  5464: 
                   5465: Returns a uniform header for LON-CAPA web pages.
                   5466: 
                   5467: Inputs: 
                   5468: 
1.112     bowersj2 5469: =over 4
                   5470: 
                   5471: =item * $title, A title to be displayed on the page.
                   5472: 
                   5473: =item * $function, the current role (can be undef).
                   5474: 
                   5475: =item * $addentries, extra parameters for the <body> tag.
                   5476: 
                   5477: =item * $bodyonly, if defined, only return the <body> tag.
                   5478: 
                   5479: =item * $domain, if defined, force a given domain.
                   5480: 
                   5481: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5482:             text interface only)
1.60      matthew  5483: 
1.814     bisitz   5484: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5485:                      navigational links
1.317     albertel 5486: 
1.338     albertel 5487: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5488: 
1.460     albertel 5489: =item * $args, optional argument valid values are
                   5490:             no_auto_mt_title -> prevents &mt()ing the title arg
                   5491: 
1.1096    raeburn  5492: =item * $advtoolsref, optional argument, ref to an array containing
                   5493:             inlineremote items to be added in "Functions" menu below
                   5494:             breadcrumbs.
                   5495: 
1.112     bowersj2 5496: =back
                   5497: 
1.60      matthew  5498: Returns: A uniform header for LON-CAPA web pages.  
                   5499: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5500: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5501: other decorations will be returned.
                   5502: 
                   5503: =cut
                   5504: 
1.54      www      5505: sub bodytag {
1.831     bisitz   5506:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5507:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5508: 
1.954     raeburn  5509:     my $public;
                   5510:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5511:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5512:         $public = 1;
                   5513:     }
1.460     albertel 5514:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  5515:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5516: 
1.183     matthew  5517:     $function = &get_users_function() if (!$function);
1.339     albertel 5518:     my $img =    &designparm($function.'.img',$domain);
                   5519:     my $font =   &designparm($function.'.font',$domain);
                   5520:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5521: 
1.803     bisitz   5522:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5523: 		   'bgcolor' => $pgbg,
1.339     albertel 5524: 		   'text'    => $font,
                   5525:                    'alink'   => &designparm($function.'.alink',$domain),
                   5526: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5527: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5528:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5529: 
1.63      www      5530:  # role and realm
1.1178    raeburn  5531:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5532:     if ($realm) {
                   5533:         $realm = '/'.$realm;
                   5534:     }
1.378     raeburn  5535:     if ($role  eq 'ca') {
1.479     albertel 5536:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5537:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5538:     } 
1.55      www      5539: # realm
1.258     albertel 5540:     if ($env{'request.course.id'}) {
1.378     raeburn  5541:         if ($env{'request.role'} !~ /^cr/) {
                   5542:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5543:         }
1.898     raeburn  5544:         if ($env{'request.course.sec'}) {
                   5545:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5546:         }   
1.359     albertel 5547: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5548:     } else {
                   5549:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5550:     }
1.433     albertel 5551: 
1.359     albertel 5552:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5553: 
1.438     albertel 5554:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5555: 
1.101     www      5556: # construct main body tag
1.359     albertel 5557:     my $bodytag = "<body $extra_body_attr>".
1.1235    raeburn  5558: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 5559: 
1.1131    raeburn  5560:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5561: 
1.1130    raeburn  5562:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5563:         return $bodytag;
1.1130    raeburn  5564:     }
1.359     albertel 5565: 
1.954     raeburn  5566:     if ($public) {
1.433     albertel 5567: 	undef($role);
                   5568:     }
1.359     albertel 5569:     
1.762     bisitz   5570:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5571:     #
                   5572:     # Extra info if you are the DC
                   5573:     my $dc_info = '';
                   5574:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5575:                         $env{'course.'.$env{'request.course.id'}.
                   5576:                                  '.domain'}.'/'})) {
                   5577:         my $cid = $env{'request.course.id'};
1.917     raeburn  5578:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5579:         $dc_info =~ s/\s+$//;
1.359     albertel 5580:     }
                   5581: 
1.1237    raeburn  5582:     my $crstype;
                   5583:     if ($env{'request.course.id'}) {
                   5584:         $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5585:     } elsif ($args->{'crstype'}) {
                   5586:         $crstype = $args->{'crstype'};
                   5587:     }
                   5588:     if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
                   5589:         undef($role);
                   5590:     } else {
1.1242    raeburn  5591:         $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237    raeburn  5592:     }
1.853     droeschl 5593: 
1.903     droeschl 5594:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5595: 
                   5596:         #    if ($env{'request.state'} eq 'construct') {
                   5597:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5598:         #    }
                   5599: 
1.1130    raeburn  5600:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  5601:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5602: 
1.1237    raeburn  5603:         my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359     albertel 5604: 
1.916     droeschl 5605:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5606:              if ($dc_info) {
                   5607:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5608:              }
1.1130    raeburn  5609:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5610:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5611:             return $bodytag;
                   5612:         }
1.894     droeschl 5613: 
1.927     raeburn  5614:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5615:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5616:         }
1.916     droeschl 5617: 
1.1130    raeburn  5618:         $bodytag .= $right;
1.852     droeschl 5619: 
1.917     raeburn  5620:         if ($dc_info) {
                   5621:             $dc_info = &dc_courseid_toggle($dc_info);
                   5622:         }
                   5623:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5624: 
1.1169    raeburn  5625:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  5626:         if ($args->{'no_secondary_menu'}) {
                   5627:             return $bodytag;
                   5628:         }
1.1169    raeburn  5629:         #don't show menus for public users
1.954     raeburn  5630:         if (!$public){
1.1154    raeburn  5631:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5632:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5633:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5634:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5635:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5636:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5637:             } elsif ($forcereg) {
                   5638:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5639:                                                             $args->{'group'});
                   5640:             } else {
                   5641:                 $bodytag .= 
                   5642:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5643:                                                         $forcereg,$args->{'group'},
                   5644:                                                         $args->{'bread_crumbs'},
                   5645:                                                         $advtoolsref);
1.920     raeburn  5646:             }
1.903     droeschl 5647:         }else{
                   5648:             # this is to seperate menu from content when there's no secondary
                   5649:             # menu. Especially needed for public accessible ressources.
                   5650:             $bodytag .= '<hr style="clear:both" />';
                   5651:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5652:         }
1.903     droeschl 5653: 
1.235     raeburn  5654:         return $bodytag;
1.182     matthew  5655: }
                   5656: 
1.917     raeburn  5657: sub dc_courseid_toggle {
                   5658:     my ($dc_info) = @_;
1.980     raeburn  5659:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5660:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5661:            &mt('(More ...)').'</a></span>'.
                   5662:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5663: }
                   5664: 
1.330     albertel 5665: sub make_attr_string {
                   5666:     my ($register,$attr_ref) = @_;
                   5667: 
                   5668:     if ($attr_ref && !ref($attr_ref)) {
                   5669: 	die("addentries Must be a hash ref ".
                   5670: 	    join(':',caller(1))." ".
                   5671: 	    join(':',caller(0))." ");
                   5672:     }
                   5673: 
                   5674:     if ($register) {
1.339     albertel 5675: 	my ($on_load,$on_unload);
                   5676: 	foreach my $key (keys(%{$attr_ref})) {
                   5677: 	    if      (lc($key) eq 'onload') {
                   5678: 		$on_load.=$attr_ref->{$key}.';';
                   5679: 		delete($attr_ref->{$key});
                   5680: 
                   5681: 	    } elsif (lc($key) eq 'onunload') {
                   5682: 		$on_unload.=$attr_ref->{$key}.';';
                   5683: 		delete($attr_ref->{$key});
                   5684: 	    }
                   5685: 	}
1.953     droeschl 5686: 	$attr_ref->{'onload'}  = $on_load;
                   5687: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5688:     }
1.339     albertel 5689: 
1.330     albertel 5690:     my $attr_string;
1.1159    raeburn  5691:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5692: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5693:     }
                   5694:     return $attr_string;
                   5695: }
                   5696: 
                   5697: 
1.182     matthew  5698: ###############################################
1.251     albertel 5699: ###############################################
                   5700: 
                   5701: =pod
                   5702: 
                   5703: =item * &endbodytag()
                   5704: 
                   5705: Returns a uniform footer for LON-CAPA web pages.
                   5706: 
1.635     raeburn  5707: Inputs: 1 - optional reference to an args hash
                   5708: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5709: a 'Continue' link is not displayed if the page contains an
                   5710: internal redirect in the <head></head> section,
                   5711: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5712: 
                   5713: =cut
                   5714: 
                   5715: sub endbodytag {
1.635     raeburn  5716:     my ($args) = @_;
1.1080    raeburn  5717:     my $endbodytag;
                   5718:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5719:         $endbodytag='</body>';
                   5720:     }
1.315     albertel 5721:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5722:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5723: 	    $endbodytag=
                   5724: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5725: 	        &mt('Continue').'</a>'.
                   5726: 	        $endbodytag;
                   5727:         }
1.315     albertel 5728:     }
1.251     albertel 5729:     return $endbodytag;
                   5730: }
                   5731: 
1.352     albertel 5732: =pod
                   5733: 
                   5734: =item * &standard_css()
                   5735: 
                   5736: Returns a style sheet
                   5737: 
                   5738: Inputs: (all optional)
                   5739:             domain         -> force to color decorate a page for a specific
                   5740:                                domain
                   5741:             function       -> force usage of a specific rolish color scheme
                   5742:             bgcolor        -> override the default page bgcolor
                   5743: 
                   5744: =cut
                   5745: 
1.343     albertel 5746: sub standard_css {
1.345     albertel 5747:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5748:     $function  = &get_users_function() if (!$function);
                   5749:     my $img    = &designparm($function.'.img',   $domain);
                   5750:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5751:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5752:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5753: #second colour for later usage
1.345     albertel 5754:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5755:     my $pgbg_or_bgcolor =
                   5756: 	         $bgcolor ||
1.352     albertel 5757: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5758:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5759:     my $alink  = &designparm($function.'.alink', $domain);
                   5760:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5761:     my $link   = &designparm($function.'.link',  $domain);
                   5762: 
1.602     albertel 5763:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5764:     my $mono                 = 'monospace';
1.850     bisitz   5765:     my $data_table_head      = $sidebg;
                   5766:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5767:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5768:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5769:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5770:     my $mail_new             = '#FFBB77';
                   5771:     my $mail_new_hover       = '#DD9955';
                   5772:     my $mail_read            = '#BBBB77';
                   5773:     my $mail_read_hover      = '#999944';
                   5774:     my $mail_replied         = '#AAAA88';
                   5775:     my $mail_replied_hover   = '#888855';
                   5776:     my $mail_other           = '#99BBBB';
                   5777:     my $mail_other_hover     = '#669999';
1.391     albertel 5778:     my $table_header         = '#DDDDDD';
1.489     raeburn  5779:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5780:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5781:     my $button_hover         = '#BF2317';
1.392     albertel 5782: 
1.608     albertel 5783:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5784:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5785:                                              : '0 3px 0 4px';
1.448     albertel 5786: 
1.523     albertel 5787: 
1.343     albertel 5788:     return <<END;
1.947     droeschl 5789: 
                   5790: /* needed for iframe to allow 100% height in FF */
                   5791: body, html { 
                   5792:     margin: 0;
                   5793:     padding: 0 0.5%;
                   5794:     height: 99%; /* to avoid scrollbars */
                   5795: }
                   5796: 
1.795     www      5797: body {
1.911     bisitz   5798:   font-family: $sans;
                   5799:   line-height:130%;
                   5800:   font-size:0.83em;
                   5801:   color:$font;
1.795     www      5802: }
                   5803: 
1.959     onken    5804: a:focus,
                   5805: a:focus img {
1.795     www      5806:   color: red;
                   5807: }
1.698     harmsja  5808: 
1.911     bisitz   5809: form, .inline {
                   5810:   display: inline;
1.795     www      5811: }
1.721     harmsja  5812: 
1.795     www      5813: .LC_right {
1.911     bisitz   5814:   text-align:right;
1.795     www      5815: }
                   5816: 
                   5817: .LC_middle {
1.911     bisitz   5818:   vertical-align:middle;
1.795     www      5819: }
1.721     harmsja  5820: 
1.1130    raeburn  5821: .LC_floatleft {
                   5822:   float: left;
                   5823: }
                   5824: 
                   5825: .LC_floatright {
                   5826:   float: right;
                   5827: }
                   5828: 
1.911     bisitz   5829: .LC_400Box {
                   5830:   width:400px;
                   5831: }
1.721     harmsja  5832: 
1.947     droeschl 5833: .LC_iframecontainer {
                   5834:     width: 98%;
                   5835:     margin: 0;
                   5836:     position: fixed;
                   5837:     top: 8.5em;
                   5838:     bottom: 0;
                   5839: }
                   5840: 
                   5841: .LC_iframecontainer iframe{
                   5842:     border: none;
                   5843:     width: 100%;
                   5844:     height: 100%;
                   5845: }
                   5846: 
1.778     bisitz   5847: .LC_filename {
                   5848:   font-family: $mono;
                   5849:   white-space:pre;
1.921     bisitz   5850:   font-size: 120%;
1.778     bisitz   5851: }
                   5852: 
                   5853: .LC_fileicon {
                   5854:   border: none;
                   5855:   height: 1.3em;
                   5856:   vertical-align: text-bottom;
                   5857:   margin-right: 0.3em;
                   5858:   text-decoration:none;
                   5859: }
                   5860: 
1.1008    www      5861: .LC_setting {
                   5862:   text-decoration:underline;
                   5863: }
                   5864: 
1.350     albertel 5865: .LC_error {
                   5866:   color: red;
                   5867: }
1.795     www      5868: 
1.1097    bisitz   5869: .LC_warning {
                   5870:   color: darkorange;
                   5871: }
                   5872: 
1.457     albertel 5873: .LC_diff_removed {
1.733     bisitz   5874:   color: red;
1.394     albertel 5875: }
1.532     albertel 5876: 
                   5877: .LC_info,
1.457     albertel 5878: .LC_success,
                   5879: .LC_diff_added {
1.350     albertel 5880:   color: green;
                   5881: }
1.795     www      5882: 
1.802     bisitz   5883: div.LC_confirm_box {
                   5884:   background-color: #FAFAFA;
                   5885:   border: 1px solid $lg_border_color;
                   5886:   margin-right: 0;
                   5887:   padding: 5px;
                   5888: }
                   5889: 
                   5890: div.LC_confirm_box .LC_error img,
                   5891: div.LC_confirm_box .LC_success img {
                   5892:   vertical-align: middle;
                   5893: }
                   5894: 
1.1242    raeburn  5895: .LC_maxwidth {
                   5896:   max-width: 100%;
                   5897:   height: auto;
                   5898: }
                   5899: 
1.1243  ! raeburn  5900: .LC_textsize_mobile {
        !          5901:   \@media only screen and (max-device-width: 480px) {
        !          5902:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
        !          5903:   }
        !          5904: }
        !          5905: 
1.440     albertel 5906: .LC_icon {
1.771     droeschl 5907:   border: none;
1.790     droeschl 5908:   vertical-align: middle;
1.771     droeschl 5909: }
                   5910: 
1.543     albertel 5911: .LC_docs_spacer {
                   5912:   width: 25px;
                   5913:   height: 1px;
1.771     droeschl 5914:   border: none;
1.543     albertel 5915: }
1.346     albertel 5916: 
1.532     albertel 5917: .LC_internal_info {
1.735     bisitz   5918:   color: #999999;
1.532     albertel 5919: }
                   5920: 
1.794     www      5921: .LC_discussion {
1.1050    www      5922:   background: $data_table_dark;
1.911     bisitz   5923:   border: 1px solid black;
                   5924:   margin: 2px;
1.794     www      5925: }
                   5926: 
                   5927: .LC_disc_action_left {
1.1050    www      5928:   background: $sidebg;
1.911     bisitz   5929:   text-align: left;
1.1050    www      5930:   padding: 4px;
                   5931:   margin: 2px;
1.794     www      5932: }
                   5933: 
                   5934: .LC_disc_action_right {
1.1050    www      5935:   background: $sidebg;
1.911     bisitz   5936:   text-align: right;
1.1050    www      5937:   padding: 4px;
                   5938:   margin: 2px;
1.794     www      5939: }
                   5940: 
                   5941: .LC_disc_new_item {
1.911     bisitz   5942:   background: white;
                   5943:   border: 2px solid red;
1.1050    www      5944:   margin: 4px;
                   5945:   padding: 4px;
1.794     www      5946: }
                   5947: 
                   5948: .LC_disc_old_item {
1.911     bisitz   5949:   background: white;
1.1050    www      5950:   margin: 4px;
                   5951:   padding: 4px;
1.794     www      5952: }
                   5953: 
1.458     albertel 5954: table.LC_pastsubmission {
                   5955:   border: 1px solid black;
                   5956:   margin: 2px;
                   5957: }
                   5958: 
1.924     bisitz   5959: table#LC_menubuttons {
1.345     albertel 5960:   width: 100%;
                   5961:   background: $pgbg;
1.392     albertel 5962:   border: 2px;
1.402     albertel 5963:   border-collapse: separate;
1.803     bisitz   5964:   padding: 0;
1.345     albertel 5965: }
1.392     albertel 5966: 
1.801     tempelho 5967: table#LC_title_bar a {
                   5968:   color: $fontmenu;
                   5969: }
1.836     bisitz   5970: 
1.807     droeschl 5971: table#LC_title_bar {
1.819     tempelho 5972:   clear: both;
1.836     bisitz   5973:   display: none;
1.807     droeschl 5974: }
                   5975: 
1.795     www      5976: table#LC_title_bar,
1.933     droeschl 5977: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5978: table#LC_title_bar.LC_with_remote {
1.359     albertel 5979:   width: 100%;
1.392     albertel 5980:   border-color: $pgbg;
                   5981:   border-style: solid;
                   5982:   border-width: $border;
1.379     albertel 5983:   background: $pgbg;
1.801     tempelho 5984:   color: $fontmenu;
1.392     albertel 5985:   border-collapse: collapse;
1.803     bisitz   5986:   padding: 0;
1.819     tempelho 5987:   margin: 0;
1.359     albertel 5988: }
1.795     www      5989: 
1.933     droeschl 5990: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5991:     margin: 0;
                   5992:     padding: 0;
1.933     droeschl 5993:     position: relative;
                   5994:     list-style: none;
1.913     droeschl 5995: }
1.933     droeschl 5996: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5997:     display: inline;
                   5998: }
1.933     droeschl 5999: 
                   6000: .LC_breadcrumb_tools_navigation {
1.913     droeschl 6001:     padding: 0;
1.933     droeschl 6002:     margin: 0;
                   6003:     float: left;
1.913     droeschl 6004: }
1.933     droeschl 6005: .LC_breadcrumb_tools_tools {
                   6006:     padding: 0;
                   6007:     margin: 0;
1.913     droeschl 6008:     float: right;
                   6009: }
                   6010: 
1.1240    raeburn  6011: .LC_placement_prog {
                   6012:     padding-right: 20px;
                   6013:     font-weight: bold;
                   6014:     font-size: 90%;
                   6015: }
                   6016: 
1.359     albertel 6017: table#LC_title_bar td {
                   6018:   background: $tabbg;
                   6019: }
1.795     www      6020: 
1.911     bisitz   6021: table#LC_menubuttons img {
1.803     bisitz   6022:   border: none;
1.346     albertel 6023: }
1.795     www      6024: 
1.842     droeschl 6025: .LC_breadcrumbs_component {
1.911     bisitz   6026:   float: right;
                   6027:   margin: 0 1em;
1.357     albertel 6028: }
1.842     droeschl 6029: .LC_breadcrumbs_component img {
1.911     bisitz   6030:   vertical-align: middle;
1.777     tempelho 6031: }
1.795     www      6032: 
1.1243  ! raeburn  6033: .LC_breadcrumbs_hoverable {
        !          6034:   background: $sidebg;
        !          6035: }
        !          6036: 
1.383     albertel 6037: td.LC_table_cell_checkbox {
                   6038:   text-align: center;
                   6039: }
1.795     www      6040: 
                   6041: .LC_fontsize_small {
1.911     bisitz   6042:   font-size: 70%;
1.705     tempelho 6043: }
                   6044: 
1.844     bisitz   6045: #LC_breadcrumbs {
1.911     bisitz   6046:   clear:both;
                   6047:   background: $sidebg;
                   6048:   border-bottom: 1px solid $lg_border_color;
                   6049:   line-height: 2.5em;
1.933     droeschl 6050:   overflow: hidden;
1.911     bisitz   6051:   margin: 0;
                   6052:   padding: 0;
1.995     raeburn  6053:   text-align: left;
1.819     tempelho 6054: }
1.862     bisitz   6055: 
1.1098    bisitz   6056: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6057:   clear:both;
                   6058:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6059:   border: 1px solid $sidebg;
1.1098    bisitz   6060:   margin: 0 0 10px 0;
1.966     bisitz   6061:   padding: 3px;
1.995     raeburn  6062:   text-align: left;
1.822     bisitz   6063: }
                   6064: 
1.795     www      6065: .LC_fontsize_medium {
1.911     bisitz   6066:   font-size: 85%;
1.705     tempelho 6067: }
                   6068: 
1.795     www      6069: .LC_fontsize_large {
1.911     bisitz   6070:   font-size: 120%;
1.705     tempelho 6071: }
                   6072: 
1.346     albertel 6073: .LC_menubuttons_inline_text {
                   6074:   color: $font;
1.698     harmsja  6075:   font-size: 90%;
1.701     harmsja  6076:   padding-left:3px;
1.346     albertel 6077: }
                   6078: 
1.934     droeschl 6079: .LC_menubuttons_inline_text img{
                   6080:   vertical-align: middle;
                   6081: }
                   6082: 
1.1051    www      6083: li.LC_menubuttons_inline_text img {
1.951     onken    6084:   cursor:pointer;
1.1002    droeschl 6085:   text-decoration: none;
1.951     onken    6086: }
                   6087: 
1.526     www      6088: .LC_menubuttons_link {
                   6089:   text-decoration: none;
                   6090: }
1.795     www      6091: 
1.522     albertel 6092: .LC_menubuttons_category {
1.521     www      6093:   color: $font;
1.526     www      6094:   background: $pgbg;
1.521     www      6095:   font-size: larger;
                   6096:   font-weight: bold;
                   6097: }
                   6098: 
1.346     albertel 6099: td.LC_menubuttons_text {
1.911     bisitz   6100:   color: $font;
1.346     albertel 6101: }
1.706     harmsja  6102: 
1.346     albertel 6103: .LC_current_location {
                   6104:   background: $tabbg;
                   6105: }
1.795     www      6106: 
1.938     bisitz   6107: table.LC_data_table {
1.347     albertel 6108:   border: 1px solid #000000;
1.402     albertel 6109:   border-collapse: separate;
1.426     albertel 6110:   border-spacing: 1px;
1.610     albertel 6111:   background: $pgbg;
1.347     albertel 6112: }
1.795     www      6113: 
1.422     albertel 6114: .LC_data_table_dense {
                   6115:   font-size: small;
                   6116: }
1.795     www      6117: 
1.507     raeburn  6118: table.LC_nested_outer {
                   6119:   border: 1px solid #000000;
1.589     raeburn  6120:   border-collapse: collapse;
1.803     bisitz   6121:   border-spacing: 0;
1.507     raeburn  6122:   width: 100%;
                   6123: }
1.795     www      6124: 
1.879     raeburn  6125: table.LC_innerpickbox,
1.507     raeburn  6126: table.LC_nested {
1.803     bisitz   6127:   border: none;
1.589     raeburn  6128:   border-collapse: collapse;
1.803     bisitz   6129:   border-spacing: 0;
1.507     raeburn  6130:   width: 100%;
                   6131: }
1.795     www      6132: 
1.911     bisitz   6133: table.LC_data_table tr th,
                   6134: table.LC_calendar tr th,
1.879     raeburn  6135: table.LC_prior_tries tr th,
                   6136: table.LC_innerpickbox tr th {
1.349     albertel 6137:   font-weight: bold;
                   6138:   background-color: $data_table_head;
1.801     tempelho 6139:   color:$fontmenu;
1.701     harmsja  6140:   font-size:90%;
1.347     albertel 6141: }
1.795     www      6142: 
1.879     raeburn  6143: table.LC_innerpickbox tr th,
                   6144: table.LC_innerpickbox tr td {
                   6145:   vertical-align: top;
                   6146: }
                   6147: 
1.711     raeburn  6148: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   6149:   background-color: #CCCCCC;
1.711     raeburn  6150:   font-weight: bold;
                   6151:   text-align: left;
                   6152: }
1.795     www      6153: 
1.912     bisitz   6154: table.LC_data_table tr.LC_odd_row > td {
                   6155:   background-color: $data_table_light;
                   6156:   padding: 2px;
                   6157:   vertical-align: top;
                   6158: }
                   6159: 
1.809     bisitz   6160: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 6161:   background-color: $data_table_light;
1.912     bisitz   6162:   vertical-align: top;
                   6163: }
                   6164: 
                   6165: table.LC_data_table tr.LC_even_row > td {
                   6166:   background-color: $data_table_dark;
1.425     albertel 6167:   padding: 2px;
1.900     bisitz   6168:   vertical-align: top;
1.347     albertel 6169: }
1.795     www      6170: 
1.809     bisitz   6171: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 6172:   background-color: $data_table_dark;
1.900     bisitz   6173:   vertical-align: top;
1.347     albertel 6174: }
1.795     www      6175: 
1.425     albertel 6176: table.LC_data_table tr.LC_data_table_highlight td {
                   6177:   background-color: $data_table_darker;
                   6178: }
1.795     www      6179: 
1.639     raeburn  6180: table.LC_data_table tr td.LC_leftcol_header {
                   6181:   background-color: $data_table_head;
                   6182:   font-weight: bold;
                   6183: }
1.795     www      6184: 
1.451     albertel 6185: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  6186: table.LC_nested tr.LC_empty_row td {
1.421     albertel 6187:   font-weight: bold;
                   6188:   font-style: italic;
                   6189:   text-align: center;
                   6190:   padding: 8px;
1.347     albertel 6191: }
1.795     www      6192: 
1.1114    raeburn  6193: table.LC_data_table tr.LC_empty_row td,
                   6194: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   6195:   background-color: $sidebg;
                   6196: }
                   6197: 
                   6198: table.LC_nested tr.LC_empty_row td {
                   6199:   background-color: #FFFFFF;
                   6200: }
                   6201: 
1.890     droeschl 6202: table.LC_caption {
                   6203: }
                   6204: 
1.507     raeburn  6205: table.LC_nested tr.LC_empty_row td {
1.465     albertel 6206:   padding: 4ex
                   6207: }
1.795     www      6208: 
1.507     raeburn  6209: table.LC_nested_outer tr th {
                   6210:   font-weight: bold;
1.801     tempelho 6211:   color:$fontmenu;
1.507     raeburn  6212:   background-color: $data_table_head;
1.701     harmsja  6213:   font-size: small;
1.507     raeburn  6214:   border-bottom: 1px solid #000000;
                   6215: }
1.795     www      6216: 
1.507     raeburn  6217: table.LC_nested_outer tr td.LC_subheader {
                   6218:   background-color: $data_table_head;
                   6219:   font-weight: bold;
                   6220:   font-size: small;
                   6221:   border-bottom: 1px solid #000000;
                   6222:   text-align: right;
1.451     albertel 6223: }
1.795     www      6224: 
1.507     raeburn  6225: table.LC_nested tr.LC_info_row td {
1.735     bisitz   6226:   background-color: #CCCCCC;
1.451     albertel 6227:   font-weight: bold;
                   6228:   font-size: small;
1.507     raeburn  6229:   text-align: center;
                   6230: }
1.795     www      6231: 
1.589     raeburn  6232: table.LC_nested tr.LC_info_row td.LC_left_item,
                   6233: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  6234:   text-align: left;
1.451     albertel 6235: }
1.795     www      6236: 
1.507     raeburn  6237: table.LC_nested td {
1.735     bisitz   6238:   background-color: #FFFFFF;
1.451     albertel 6239:   font-size: small;
1.507     raeburn  6240: }
1.795     www      6241: 
1.507     raeburn  6242: table.LC_nested_outer tr th.LC_right_item,
                   6243: table.LC_nested tr.LC_info_row td.LC_right_item,
                   6244: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   6245: table.LC_nested tr td.LC_right_item {
1.451     albertel 6246:   text-align: right;
                   6247: }
                   6248: 
1.507     raeburn  6249: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   6250:   background-color: #EEEEEE;
1.451     albertel 6251: }
                   6252: 
1.473     raeburn  6253: table.LC_createuser {
                   6254: }
                   6255: 
                   6256: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  6257:   font-size: small;
1.473     raeburn  6258: }
                   6259: 
                   6260: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   6261:   background-color: #CCCCCC;
1.473     raeburn  6262:   font-weight: bold;
                   6263:   text-align: center;
                   6264: }
                   6265: 
1.349     albertel 6266: table.LC_calendar {
                   6267:   border: 1px solid #000000;
                   6268:   border-collapse: collapse;
1.917     raeburn  6269:   width: 98%;
1.349     albertel 6270: }
1.795     www      6271: 
1.349     albertel 6272: table.LC_calendar_pickdate {
                   6273:   font-size: xx-small;
                   6274: }
1.795     www      6275: 
1.349     albertel 6276: table.LC_calendar tr td {
                   6277:   border: 1px solid #000000;
                   6278:   vertical-align: top;
1.917     raeburn  6279:   width: 14%;
1.349     albertel 6280: }
1.795     www      6281: 
1.349     albertel 6282: table.LC_calendar tr td.LC_calendar_day_empty {
                   6283:   background-color: $data_table_dark;
                   6284: }
1.795     www      6285: 
1.779     bisitz   6286: table.LC_calendar tr td.LC_calendar_day_current {
                   6287:   background-color: $data_table_highlight;
1.777     tempelho 6288: }
1.795     www      6289: 
1.938     bisitz   6290: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 6291:   background-color: $mail_new;
                   6292: }
1.795     www      6293: 
1.938     bisitz   6294: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 6295:   background-color: $mail_new_hover;
                   6296: }
1.795     www      6297: 
1.938     bisitz   6298: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 6299:   background-color: $mail_read;
                   6300: }
1.795     www      6301: 
1.938     bisitz   6302: /*
                   6303: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 6304:   background-color: $mail_read_hover;
                   6305: }
1.938     bisitz   6306: */
1.795     www      6307: 
1.938     bisitz   6308: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 6309:   background-color: $mail_replied;
                   6310: }
1.795     www      6311: 
1.938     bisitz   6312: /*
                   6313: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 6314:   background-color: $mail_replied_hover;
                   6315: }
1.938     bisitz   6316: */
1.795     www      6317: 
1.938     bisitz   6318: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6319:   background-color: $mail_other;
                   6320: }
1.795     www      6321: 
1.938     bisitz   6322: /*
                   6323: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6324:   background-color: $mail_other_hover;
                   6325: }
1.938     bisitz   6326: */
1.494     raeburn  6327: 
1.777     tempelho 6328: table.LC_data_table tr > td.LC_browser_file,
                   6329: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6330:   background: #AAEE77;
1.389     albertel 6331: }
1.795     www      6332: 
1.777     tempelho 6333: table.LC_data_table tr > td.LC_browser_file_locked,
                   6334: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6335:   background: #FFAA99;
1.387     albertel 6336: }
1.795     www      6337: 
1.777     tempelho 6338: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6339:   background: #888888;
1.779     bisitz   6340: }
1.795     www      6341: 
1.777     tempelho 6342: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6343: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6344:   background: #F8F866;
1.777     tempelho 6345: }
1.795     www      6346: 
1.696     bisitz   6347: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6348:   background: #E0E8FF;
1.387     albertel 6349: }
1.696     bisitz   6350: 
1.707     bisitz   6351: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6352:   /* background: #77FF77; */
1.707     bisitz   6353: }
1.795     www      6354: 
1.707     bisitz   6355: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6356:   border-right: 8px solid #FFFF77;
1.707     bisitz   6357: }
1.795     www      6358: 
1.707     bisitz   6359: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6360:   border-right: 8px solid #FFAA77;
1.707     bisitz   6361: }
1.795     www      6362: 
1.707     bisitz   6363: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6364:   border-right: 8px solid #FF7777;
1.707     bisitz   6365: }
1.795     www      6366: 
1.707     bisitz   6367: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6368:   border-right: 8px solid #AAFF77;
1.707     bisitz   6369: }
1.795     www      6370: 
1.707     bisitz   6371: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6372:   border-right: 8px solid #11CC55;
1.707     bisitz   6373: }
                   6374: 
1.388     albertel 6375: span.LC_current_location {
1.701     harmsja  6376:   font-size:larger;
1.388     albertel 6377:   background: $pgbg;
                   6378: }
1.387     albertel 6379: 
1.1029    www      6380: span.LC_current_nav_location {
                   6381:   font-weight:bold;
                   6382:   background: $sidebg;
                   6383: }
                   6384: 
1.395     albertel 6385: span.LC_parm_menu_item {
                   6386:   font-size: larger;
                   6387: }
1.795     www      6388: 
1.395     albertel 6389: span.LC_parm_scope_all {
                   6390:   color: red;
                   6391: }
1.795     www      6392: 
1.395     albertel 6393: span.LC_parm_scope_folder {
                   6394:   color: green;
                   6395: }
1.795     www      6396: 
1.395     albertel 6397: span.LC_parm_scope_resource {
                   6398:   color: orange;
                   6399: }
1.795     www      6400: 
1.395     albertel 6401: span.LC_parm_part {
                   6402:   color: blue;
                   6403: }
1.795     www      6404: 
1.911     bisitz   6405: span.LC_parm_folder,
                   6406: span.LC_parm_symb {
1.395     albertel 6407:   font-size: x-small;
                   6408:   font-family: $mono;
                   6409:   color: #AAAAAA;
                   6410: }
                   6411: 
1.977     bisitz   6412: ul.LC_parm_parmlist li {
                   6413:   display: inline-block;
                   6414:   padding: 0.3em 0.8em;
                   6415:   vertical-align: top;
                   6416:   width: 150px;
                   6417:   border-top:1px solid $lg_border_color;
                   6418: }
                   6419: 
1.795     www      6420: td.LC_parm_overview_level_menu,
                   6421: td.LC_parm_overview_map_menu,
                   6422: td.LC_parm_overview_parm_selectors,
                   6423: td.LC_parm_overview_restrictions  {
1.396     albertel 6424:   border: 1px solid black;
                   6425:   border-collapse: collapse;
                   6426: }
1.795     www      6427: 
1.396     albertel 6428: table.LC_parm_overview_restrictions td {
                   6429:   border-width: 1px 4px 1px 4px;
                   6430:   border-style: solid;
                   6431:   border-color: $pgbg;
                   6432:   text-align: center;
                   6433: }
1.795     www      6434: 
1.396     albertel 6435: table.LC_parm_overview_restrictions th {
                   6436:   background: $tabbg;
                   6437:   border-width: 1px 4px 1px 4px;
                   6438:   border-style: solid;
                   6439:   border-color: $pgbg;
                   6440: }
1.795     www      6441: 
1.398     albertel 6442: table#LC_helpmenu {
1.803     bisitz   6443:   border: none;
1.398     albertel 6444:   height: 55px;
1.803     bisitz   6445:   border-spacing: 0;
1.398     albertel 6446: }
                   6447: 
                   6448: table#LC_helpmenu fieldset legend {
                   6449:   font-size: larger;
                   6450: }
1.795     www      6451: 
1.397     albertel 6452: table#LC_helpmenu_links {
                   6453:   width: 100%;
                   6454:   border: 1px solid black;
                   6455:   background: $pgbg;
1.803     bisitz   6456:   padding: 0;
1.397     albertel 6457:   border-spacing: 1px;
                   6458: }
1.795     www      6459: 
1.397     albertel 6460: table#LC_helpmenu_links tr td {
                   6461:   padding: 1px;
                   6462:   background: $tabbg;
1.399     albertel 6463:   text-align: center;
                   6464:   font-weight: bold;
1.397     albertel 6465: }
1.396     albertel 6466: 
1.795     www      6467: table#LC_helpmenu_links a:link,
                   6468: table#LC_helpmenu_links a:visited,
1.397     albertel 6469: table#LC_helpmenu_links a:active {
                   6470:   text-decoration: none;
                   6471:   color: $font;
                   6472: }
1.795     www      6473: 
1.397     albertel 6474: table#LC_helpmenu_links a:hover {
                   6475:   text-decoration: underline;
                   6476:   color: $vlink;
                   6477: }
1.396     albertel 6478: 
1.417     albertel 6479: .LC_chrt_popup_exists {
                   6480:   border: 1px solid #339933;
                   6481:   margin: -1px;
                   6482: }
1.795     www      6483: 
1.417     albertel 6484: .LC_chrt_popup_up {
                   6485:   border: 1px solid yellow;
                   6486:   margin: -1px;
                   6487: }
1.795     www      6488: 
1.417     albertel 6489: .LC_chrt_popup {
                   6490:   border: 1px solid #8888FF;
                   6491:   background: #CCCCFF;
                   6492: }
1.795     www      6493: 
1.421     albertel 6494: table.LC_pick_box {
                   6495:   border-collapse: separate;
                   6496:   background: white;
                   6497:   border: 1px solid black;
                   6498:   border-spacing: 1px;
                   6499: }
1.795     www      6500: 
1.421     albertel 6501: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6502:   background: $sidebg;
1.421     albertel 6503:   font-weight: bold;
1.900     bisitz   6504:   text-align: left;
1.740     bisitz   6505:   vertical-align: top;
1.421     albertel 6506:   width: 184px;
                   6507:   padding: 8px;
                   6508: }
1.795     www      6509: 
1.579     raeburn  6510: table.LC_pick_box td.LC_pick_box_value {
                   6511:   text-align: left;
                   6512:   padding: 8px;
                   6513: }
1.795     www      6514: 
1.579     raeburn  6515: table.LC_pick_box td.LC_pick_box_select {
                   6516:   text-align: left;
                   6517:   padding: 8px;
                   6518: }
1.795     www      6519: 
1.424     albertel 6520: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6521:   padding: 0;
1.421     albertel 6522:   height: 1px;
                   6523:   background: black;
                   6524: }
1.795     www      6525: 
1.421     albertel 6526: table.LC_pick_box td.LC_pick_box_submit {
                   6527:   text-align: right;
                   6528: }
1.795     www      6529: 
1.579     raeburn  6530: table.LC_pick_box td.LC_evenrow_value {
                   6531:   text-align: left;
                   6532:   padding: 8px;
                   6533:   background-color: $data_table_light;
                   6534: }
1.795     www      6535: 
1.579     raeburn  6536: table.LC_pick_box td.LC_oddrow_value {
                   6537:   text-align: left;
                   6538:   padding: 8px;
                   6539:   background-color: $data_table_light;
                   6540: }
1.795     www      6541: 
1.579     raeburn  6542: span.LC_helpform_receipt_cat {
                   6543:   font-weight: bold;
                   6544: }
1.795     www      6545: 
1.424     albertel 6546: table.LC_group_priv_box {
                   6547:   background: white;
                   6548:   border: 1px solid black;
                   6549:   border-spacing: 1px;
                   6550: }
1.795     www      6551: 
1.424     albertel 6552: table.LC_group_priv_box td.LC_pick_box_title {
                   6553:   background: $tabbg;
                   6554:   font-weight: bold;
                   6555:   text-align: right;
                   6556:   width: 184px;
                   6557: }
1.795     www      6558: 
1.424     albertel 6559: table.LC_group_priv_box td.LC_groups_fixed {
                   6560:   background: $data_table_light;
                   6561:   text-align: center;
                   6562: }
1.795     www      6563: 
1.424     albertel 6564: table.LC_group_priv_box td.LC_groups_optional {
                   6565:   background: $data_table_dark;
                   6566:   text-align: center;
                   6567: }
1.795     www      6568: 
1.424     albertel 6569: table.LC_group_priv_box td.LC_groups_functionality {
                   6570:   background: $data_table_darker;
                   6571:   text-align: center;
                   6572:   font-weight: bold;
                   6573: }
1.795     www      6574: 
1.424     albertel 6575: table.LC_group_priv td {
                   6576:   text-align: left;
1.803     bisitz   6577:   padding: 0;
1.424     albertel 6578: }
                   6579: 
                   6580: .LC_navbuttons {
                   6581:   margin: 2ex 0ex 2ex 0ex;
                   6582: }
1.795     www      6583: 
1.423     albertel 6584: .LC_topic_bar {
                   6585:   font-weight: bold;
                   6586:   background: $tabbg;
1.918     wenzelju 6587:   margin: 1em 0em 1em 2em;
1.805     bisitz   6588:   padding: 3px;
1.918     wenzelju 6589:   font-size: 1.2em;
1.423     albertel 6590: }
1.795     www      6591: 
1.423     albertel 6592: .LC_topic_bar span {
1.918     wenzelju 6593:   left: 0.5em;
                   6594:   position: absolute;
1.423     albertel 6595:   vertical-align: middle;
1.918     wenzelju 6596:   font-size: 1.2em;
1.423     albertel 6597: }
1.795     www      6598: 
1.423     albertel 6599: table.LC_course_group_status {
                   6600:   margin: 20px;
                   6601: }
1.795     www      6602: 
1.423     albertel 6603: table.LC_status_selector td {
                   6604:   vertical-align: top;
                   6605:   text-align: center;
1.424     albertel 6606:   padding: 4px;
                   6607: }
1.795     www      6608: 
1.599     albertel 6609: div.LC_feedback_link {
1.616     albertel 6610:   clear: both;
1.829     kalberla 6611:   background: $sidebg;
1.779     bisitz   6612:   width: 100%;
1.829     kalberla 6613:   padding-bottom: 10px;
                   6614:   border: 1px $tabbg solid;
1.833     kalberla 6615:   height: 22px;
                   6616:   line-height: 22px;
                   6617:   padding-top: 5px;
                   6618: }
                   6619: 
                   6620: div.LC_feedback_link img {
                   6621:   height: 22px;
1.867     kalberla 6622:   vertical-align:middle;
1.829     kalberla 6623: }
                   6624: 
1.911     bisitz   6625: div.LC_feedback_link a {
1.829     kalberla 6626:   text-decoration: none;
1.489     raeburn  6627: }
1.795     www      6628: 
1.867     kalberla 6629: div.LC_comblock {
1.911     bisitz   6630:   display:inline;
1.867     kalberla 6631:   color:$font;
                   6632:   font-size:90%;
                   6633: }
                   6634: 
                   6635: div.LC_feedback_link div.LC_comblock {
                   6636:   padding-left:5px;
                   6637: }
                   6638: 
                   6639: div.LC_feedback_link div.LC_comblock a {
                   6640:   color:$font;
                   6641: }
                   6642: 
1.489     raeburn  6643: span.LC_feedback_link {
1.858     bisitz   6644:   /* background: $feedback_link_bg; */
1.599     albertel 6645:   font-size: larger;
                   6646: }
1.795     www      6647: 
1.599     albertel 6648: span.LC_message_link {
1.858     bisitz   6649:   /* background: $feedback_link_bg; */
1.599     albertel 6650:   font-size: larger;
                   6651:   position: absolute;
                   6652:   right: 1em;
1.489     raeburn  6653: }
1.421     albertel 6654: 
1.515     albertel 6655: table.LC_prior_tries {
1.524     albertel 6656:   border: 1px solid #000000;
                   6657:   border-collapse: separate;
                   6658:   border-spacing: 1px;
1.515     albertel 6659: }
1.523     albertel 6660: 
1.515     albertel 6661: table.LC_prior_tries td {
1.524     albertel 6662:   padding: 2px;
1.515     albertel 6663: }
1.523     albertel 6664: 
                   6665: .LC_answer_correct {
1.795     www      6666:   background: lightgreen;
                   6667:   color: darkgreen;
                   6668:   padding: 6px;
1.523     albertel 6669: }
1.795     www      6670: 
1.523     albertel 6671: .LC_answer_charged_try {
1.797     www      6672:   background: #FFAAAA;
1.795     www      6673:   color: darkred;
                   6674:   padding: 6px;
1.523     albertel 6675: }
1.795     www      6676: 
1.779     bisitz   6677: .LC_answer_not_charged_try,
1.523     albertel 6678: .LC_answer_no_grade,
                   6679: .LC_answer_late {
1.795     www      6680:   background: lightyellow;
1.523     albertel 6681:   color: black;
1.795     www      6682:   padding: 6px;
1.523     albertel 6683: }
1.795     www      6684: 
1.523     albertel 6685: .LC_answer_previous {
1.795     www      6686:   background: lightblue;
                   6687:   color: darkblue;
                   6688:   padding: 6px;
1.523     albertel 6689: }
1.795     www      6690: 
1.779     bisitz   6691: .LC_answer_no_message {
1.777     tempelho 6692:   background: #FFFFFF;
                   6693:   color: black;
1.795     www      6694:   padding: 6px;
1.779     bisitz   6695: }
1.795     www      6696: 
1.779     bisitz   6697: .LC_answer_unknown {
                   6698:   background: orange;
                   6699:   color: black;
1.795     www      6700:   padding: 6px;
1.777     tempelho 6701: }
1.795     www      6702: 
1.529     albertel 6703: span.LC_prior_numerical,
                   6704: span.LC_prior_string,
                   6705: span.LC_prior_custom,
                   6706: span.LC_prior_reaction,
                   6707: span.LC_prior_math {
1.925     bisitz   6708:   font-family: $mono;
1.523     albertel 6709:   white-space: pre;
                   6710: }
                   6711: 
1.525     albertel 6712: span.LC_prior_string {
1.925     bisitz   6713:   font-family: $mono;
1.525     albertel 6714:   white-space: pre;
                   6715: }
                   6716: 
1.523     albertel 6717: table.LC_prior_option {
                   6718:   width: 100%;
                   6719:   border-collapse: collapse;
                   6720: }
1.795     www      6721: 
1.911     bisitz   6722: table.LC_prior_rank,
1.795     www      6723: table.LC_prior_match {
1.528     albertel 6724:   border-collapse: collapse;
                   6725: }
1.795     www      6726: 
1.528     albertel 6727: table.LC_prior_option tr td,
                   6728: table.LC_prior_rank tr td,
                   6729: table.LC_prior_match tr td {
1.524     albertel 6730:   border: 1px solid #000000;
1.515     albertel 6731: }
                   6732: 
1.855     bisitz   6733: .LC_nobreak {
1.544     albertel 6734:   white-space: nowrap;
1.519     raeburn  6735: }
                   6736: 
1.576     raeburn  6737: span.LC_cusr_emph {
                   6738:   font-style: italic;
                   6739: }
                   6740: 
1.633     raeburn  6741: span.LC_cusr_subheading {
                   6742:   font-weight: normal;
                   6743:   font-size: 85%;
                   6744: }
                   6745: 
1.861     bisitz   6746: div.LC_docs_entry_move {
1.859     bisitz   6747:   border: 1px solid #BBBBBB;
1.545     albertel 6748:   background: #DDDDDD;
1.861     bisitz   6749:   width: 22px;
1.859     bisitz   6750:   padding: 1px;
                   6751:   margin: 0;
1.545     albertel 6752: }
                   6753: 
1.861     bisitz   6754: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6755: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6756:   font-size: x-small;
                   6757: }
1.795     www      6758: 
1.861     bisitz   6759: .LC_docs_entry_parameter {
                   6760:   white-space: nowrap;
                   6761: }
                   6762: 
1.544     albertel 6763: .LC_docs_copy {
1.545     albertel 6764:   color: #000099;
1.544     albertel 6765: }
1.795     www      6766: 
1.544     albertel 6767: .LC_docs_cut {
1.545     albertel 6768:   color: #550044;
1.544     albertel 6769: }
1.795     www      6770: 
1.544     albertel 6771: .LC_docs_rename {
1.545     albertel 6772:   color: #009900;
1.544     albertel 6773: }
1.795     www      6774: 
1.544     albertel 6775: .LC_docs_remove {
1.545     albertel 6776:   color: #990000;
                   6777: }
                   6778: 
1.547     albertel 6779: .LC_docs_reinit_warn,
                   6780: .LC_docs_ext_edit {
                   6781:   font-size: x-small;
                   6782: }
                   6783: 
1.545     albertel 6784: table.LC_docs_adddocs td,
                   6785: table.LC_docs_adddocs th {
                   6786:   border: 1px solid #BBBBBB;
                   6787:   padding: 4px;
                   6788:   background: #DDDDDD;
1.543     albertel 6789: }
                   6790: 
1.584     albertel 6791: table.LC_sty_begin {
                   6792:   background: #BBFFBB;
                   6793: }
1.795     www      6794: 
1.584     albertel 6795: table.LC_sty_end {
                   6796:   background: #FFBBBB;
                   6797: }
                   6798: 
1.589     raeburn  6799: table.LC_double_column {
1.803     bisitz   6800:   border-width: 0;
1.589     raeburn  6801:   border-collapse: collapse;
                   6802:   width: 100%;
                   6803:   padding: 2px;
                   6804: }
                   6805: 
                   6806: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6807:   top: 2px;
1.589     raeburn  6808:   left: 2px;
                   6809:   width: 47%;
                   6810:   vertical-align: top;
                   6811: }
                   6812: 
                   6813: table.LC_double_column tr td.LC_right_col {
                   6814:   top: 2px;
1.779     bisitz   6815:   right: 2px;
1.589     raeburn  6816:   width: 47%;
                   6817:   vertical-align: top;
                   6818: }
                   6819: 
1.591     raeburn  6820: div.LC_left_float {
                   6821:   float: left;
                   6822:   padding-right: 5%;
1.597     albertel 6823:   padding-bottom: 4px;
1.591     raeburn  6824: }
                   6825: 
                   6826: div.LC_clear_float_header {
1.597     albertel 6827:   padding-bottom: 2px;
1.591     raeburn  6828: }
                   6829: 
                   6830: div.LC_clear_float_footer {
1.597     albertel 6831:   padding-top: 10px;
1.591     raeburn  6832:   clear: both;
                   6833: }
                   6834: 
1.597     albertel 6835: div.LC_grade_show_user {
1.941     bisitz   6836: /*  border-left: 5px solid $sidebg; */
                   6837:   border-top: 5px solid #000000;
                   6838:   margin: 50px 0 0 0;
1.936     bisitz   6839:   padding: 15px 0 5px 10px;
1.597     albertel 6840: }
1.795     www      6841: 
1.936     bisitz   6842: div.LC_grade_show_user_odd_row {
1.941     bisitz   6843: /*  border-left: 5px solid #000000; */
                   6844: }
                   6845: 
                   6846: div.LC_grade_show_user div.LC_Box {
                   6847:   margin-right: 50px;
1.597     albertel 6848: }
                   6849: 
                   6850: div.LC_grade_submissions,
                   6851: div.LC_grade_message_center,
1.936     bisitz   6852: div.LC_grade_info_links {
1.597     albertel 6853:   margin: 5px;
                   6854:   width: 99%;
                   6855:   background: #FFFFFF;
                   6856: }
1.795     www      6857: 
1.597     albertel 6858: div.LC_grade_submissions_header,
1.936     bisitz   6859: div.LC_grade_message_center_header {
1.705     tempelho 6860:   font-weight: bold;
                   6861:   font-size: large;
1.597     albertel 6862: }
1.795     www      6863: 
1.597     albertel 6864: div.LC_grade_submissions_body,
1.936     bisitz   6865: div.LC_grade_message_center_body {
1.597     albertel 6866:   border: 1px solid black;
                   6867:   width: 99%;
                   6868:   background: #FFFFFF;
                   6869: }
1.795     www      6870: 
1.613     albertel 6871: table.LC_scantron_action {
                   6872:   width: 100%;
                   6873: }
1.795     www      6874: 
1.613     albertel 6875: table.LC_scantron_action tr th {
1.698     harmsja  6876:   font-weight:bold;
                   6877:   font-style:normal;
1.613     albertel 6878: }
1.795     www      6879: 
1.779     bisitz   6880: .LC_edit_problem_header,
1.614     albertel 6881: div.LC_edit_problem_footer {
1.705     tempelho 6882:   font-weight: normal;
                   6883:   font-size:  medium;
1.602     albertel 6884:   margin: 2px;
1.1060    bisitz   6885:   background-color: $sidebg;
1.600     albertel 6886: }
1.795     www      6887: 
1.600     albertel 6888: div.LC_edit_problem_header,
1.602     albertel 6889: div.LC_edit_problem_header div,
1.614     albertel 6890: div.LC_edit_problem_footer,
                   6891: div.LC_edit_problem_footer div,
1.602     albertel 6892: div.LC_edit_problem_editxml_header,
                   6893: div.LC_edit_problem_editxml_header div {
1.1205    golterma 6894:   z-index: 100;
1.600     albertel 6895: }
1.795     www      6896: 
1.600     albertel 6897: div.LC_edit_problem_header_title {
1.705     tempelho 6898:   font-weight: bold;
                   6899:   font-size: larger;
1.602     albertel 6900:   background: $tabbg;
                   6901:   padding: 3px;
1.1060    bisitz   6902:   margin: 0 0 5px 0;
1.602     albertel 6903: }
1.795     www      6904: 
1.602     albertel 6905: table.LC_edit_problem_header_title {
                   6906:   width: 100%;
1.600     albertel 6907:   background: $tabbg;
1.602     albertel 6908: }
                   6909: 
1.1205    golterma 6910: div.LC_edit_actionbar {
                   6911:     background-color: $sidebg;
1.1218    droeschl 6912:     margin: 0;
                   6913:     padding: 0;
                   6914:     line-height: 200%;
1.602     albertel 6915: }
1.795     www      6916: 
1.1218    droeschl 6917: div.LC_edit_actionbar div{
                   6918:     padding: 0;
                   6919:     margin: 0;
                   6920:     display: inline-block;
1.600     albertel 6921: }
1.795     www      6922: 
1.1124    bisitz   6923: .LC_edit_opt {
                   6924:   padding-left: 1em;
                   6925:   white-space: nowrap;
                   6926: }
                   6927: 
1.1152    golterma 6928: .LC_edit_problem_latexhelper{
                   6929:     text-align: right;
                   6930: }
                   6931: 
                   6932: #LC_edit_problem_colorful div{
                   6933:     margin-left: 40px;
                   6934: }
                   6935: 
1.1205    golterma 6936: #LC_edit_problem_codemirror div{
                   6937:     margin-left: 0px;
                   6938: }
                   6939: 
1.911     bisitz   6940: img.stift {
1.803     bisitz   6941:   border-width: 0;
                   6942:   vertical-align: middle;
1.677     riegler  6943: }
1.680     riegler  6944: 
1.923     bisitz   6945: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6946:   vertical-align: top;
1.777     tempelho 6947: }
1.795     www      6948: 
1.716     raeburn  6949: div.LC_createcourse {
1.911     bisitz   6950:   margin: 10px 10px 10px 10px;
1.716     raeburn  6951: }
                   6952: 
1.917     raeburn  6953: .LC_dccid {
1.1130    raeburn  6954:   float: right;
1.917     raeburn  6955:   margin: 0.2em 0 0 0;
                   6956:   padding: 0;
                   6957:   font-size: 90%;
                   6958:   display:none;
                   6959: }
                   6960: 
1.897     wenzelju 6961: ol.LC_primary_menu a:hover,
1.721     harmsja  6962: ol#LC_MenuBreadcrumbs a:hover,
                   6963: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6964: ul#LC_secondary_menu a:hover,
1.721     harmsja  6965: .LC_FormSectionClearButton input:hover
1.795     www      6966: ul.LC_TabContent   li:hover a {
1.952     onken    6967:   color:$button_hover;
1.911     bisitz   6968:   text-decoration:none;
1.693     droeschl 6969: }
                   6970: 
1.779     bisitz   6971: h1 {
1.911     bisitz   6972:   padding: 0;
                   6973:   line-height:130%;
1.693     droeschl 6974: }
1.698     harmsja  6975: 
1.911     bisitz   6976: h2,
                   6977: h3,
                   6978: h4,
                   6979: h5,
                   6980: h6 {
                   6981:   margin: 5px 0 5px 0;
                   6982:   padding: 0;
                   6983:   line-height:130%;
1.693     droeschl 6984: }
1.795     www      6985: 
                   6986: .LC_hcell {
1.911     bisitz   6987:   padding:3px 15px 3px 15px;
                   6988:   margin: 0;
                   6989:   background-color:$tabbg;
                   6990:   color:$fontmenu;
                   6991:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6992: }
1.795     www      6993: 
1.840     bisitz   6994: .LC_Box > .LC_hcell {
1.911     bisitz   6995:   margin: 0 -10px 10px -10px;
1.835     bisitz   6996: }
                   6997: 
1.721     harmsja  6998: .LC_noBorder {
1.911     bisitz   6999:   border: 0;
1.698     harmsja  7000: }
1.693     droeschl 7001: 
1.721     harmsja  7002: .LC_FormSectionClearButton input {
1.911     bisitz   7003:   background-color:transparent;
                   7004:   border: none;
                   7005:   cursor:pointer;
                   7006:   text-decoration:underline;
1.693     droeschl 7007: }
1.763     bisitz   7008: 
                   7009: .LC_help_open_topic {
1.911     bisitz   7010:   color: #FFFFFF;
                   7011:   background-color: #EEEEFF;
                   7012:   margin: 1px;
                   7013:   padding: 4px;
                   7014:   border: 1px solid #000033;
                   7015:   white-space: nowrap;
                   7016:   /* vertical-align: middle; */
1.759     neumanie 7017: }
1.693     droeschl 7018: 
1.911     bisitz   7019: dl,
                   7020: ul,
                   7021: div,
                   7022: fieldset {
                   7023:   margin: 10px 10px 10px 0;
                   7024:   /* overflow: hidden; */
1.693     droeschl 7025: }
1.795     www      7026: 
1.1211    raeburn  7027: article.geogebraweb div {
                   7028:     margin: 0;
                   7029: }
                   7030: 
1.838     bisitz   7031: fieldset > legend {
1.911     bisitz   7032:   font-weight: bold;
                   7033:   padding: 0 5px 0 5px;
1.838     bisitz   7034: }
                   7035: 
1.813     bisitz   7036: #LC_nav_bar {
1.911     bisitz   7037:   float: left;
1.995     raeburn  7038:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   7039:   margin: 0 0 2px 0;
1.807     droeschl 7040: }
                   7041: 
1.916     droeschl 7042: #LC_realm {
                   7043:   margin: 0.2em 0 0 0;
                   7044:   padding: 0;
                   7045:   font-weight: bold;
                   7046:   text-align: center;
1.995     raeburn  7047:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7048: }
                   7049: 
1.911     bisitz   7050: #LC_nav_bar em {
                   7051:   font-weight: bold;
                   7052:   font-style: normal;
1.807     droeschl 7053: }
                   7054: 
1.897     wenzelju 7055: ol.LC_primary_menu {
1.934     droeschl 7056:   margin: 0;
1.1076    raeburn  7057:   padding: 0;
1.807     droeschl 7058: }
                   7059: 
1.852     droeschl 7060: ol#LC_PathBreadcrumbs {
1.911     bisitz   7061:   margin: 0;
1.693     droeschl 7062: }
                   7063: 
1.897     wenzelju 7064: ol.LC_primary_menu li {
1.1076    raeburn  7065:   color: RGB(80, 80, 80);
                   7066:   vertical-align: middle;
                   7067:   text-align: left;
                   7068:   list-style: none;
1.1205    golterma 7069:   position: relative;
1.1076    raeburn  7070:   float: left;
1.1205    golterma 7071:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7072:   line-height: 1.5em;
1.1076    raeburn  7073: }
                   7074: 
1.1205    golterma 7075: ol.LC_primary_menu li a,
                   7076: ol.LC_primary_menu li p {
1.1076    raeburn  7077:   display: block;
                   7078:   margin: 0;
                   7079:   padding: 0 5px 0 10px;
                   7080:   text-decoration: none;
                   7081: }
                   7082: 
1.1205    golterma 7083: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   7084:   display: inline-block;
                   7085:   width: 95%;
                   7086:   text-align: left;
                   7087: }
                   7088: 
                   7089: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   7090:   display: inline-block;	
                   7091:   width: 5%;
                   7092:   float: right;
                   7093:   text-align: right;
                   7094:   font-size: 70%;
                   7095: }
                   7096: 
                   7097: ol.LC_primary_menu ul {
1.1076    raeburn  7098:   display: none;
1.1205    golterma 7099:   width: 15em;
1.1076    raeburn  7100:   background-color: $data_table_light;
1.1205    golterma 7101:   position: absolute;
                   7102:   top: 100%;
1.1076    raeburn  7103: }
                   7104: 
1.1205    golterma 7105: ol.LC_primary_menu ul ul {
                   7106:   left: 100%;
                   7107:   top: 0;
                   7108: }
                   7109: 
                   7110: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076    raeburn  7111:   display: block;
                   7112:   position: absolute;
                   7113:   margin: 0;
                   7114:   padding: 0;
1.1078    raeburn  7115:   z-index: 2;
1.1076    raeburn  7116: }
                   7117: 
                   7118: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205    golterma 7119: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076    raeburn  7120:   font-size: 90%;
1.911     bisitz   7121:   vertical-align: top;
1.1076    raeburn  7122:   float: none;
1.1079    raeburn  7123:   border-left: 1px solid black;
                   7124:   border-right: 1px solid black;
1.1205    golterma 7125: /* A dark bottom border to visualize different menu options; 
                   7126: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   7127:   border-bottom: 1px solid $data_table_dark; 
1.1076    raeburn  7128: }
                   7129: 
1.1205    golterma 7130: ol.LC_primary_menu li li p:hover {
                   7131:   color:$button_hover;
                   7132:   text-decoration:none;
                   7133:   background-color:$data_table_dark;
1.1076    raeburn  7134: }
                   7135: 
                   7136: ol.LC_primary_menu li li a:hover {
                   7137:    color:$button_hover;
                   7138:    background-color:$data_table_dark;
1.693     droeschl 7139: }
                   7140: 
1.1205    golterma 7141: /* Font-size equal to the size of the predecessors*/
                   7142: ol.LC_primary_menu li:hover li li {
                   7143:   font-size: 100%;
                   7144: }
                   7145: 
1.897     wenzelju 7146: ol.LC_primary_menu li img {
1.911     bisitz   7147:   vertical-align: bottom;
1.934     droeschl 7148:   height: 1.1em;
1.1077    raeburn  7149:   margin: 0.2em 0 0 0;
1.693     droeschl 7150: }
                   7151: 
1.897     wenzelju 7152: ol.LC_primary_menu a {
1.911     bisitz   7153:   color: RGB(80, 80, 80);
                   7154:   text-decoration: none;
1.693     droeschl 7155: }
1.795     www      7156: 
1.949     droeschl 7157: ol.LC_primary_menu a.LC_new_message {
                   7158:   font-weight:bold;
                   7159:   color: darkred;
                   7160: }
                   7161: 
1.975     raeburn  7162: ol.LC_docs_parameters {
                   7163:   margin-left: 0;
                   7164:   padding: 0;
                   7165:   list-style: none;
                   7166: }
                   7167: 
                   7168: ol.LC_docs_parameters li {
                   7169:   margin: 0;
                   7170:   padding-right: 20px;
                   7171:   display: inline;
                   7172: }
                   7173: 
1.976     raeburn  7174: ol.LC_docs_parameters li:before {
                   7175:   content: "\\002022 \\0020";
                   7176: }
                   7177: 
                   7178: li.LC_docs_parameters_title {
                   7179:   font-weight: bold;
                   7180: }
                   7181: 
                   7182: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   7183:   content: "";
                   7184: }
                   7185: 
1.897     wenzelju 7186: ul#LC_secondary_menu {
1.1107    raeburn  7187:   clear: right;
1.911     bisitz   7188:   color: $fontmenu;
                   7189:   background: $tabbg;
                   7190:   list-style: none;
                   7191:   padding: 0;
                   7192:   margin: 0;
                   7193:   width: 100%;
1.995     raeburn  7194:   text-align: left;
1.1107    raeburn  7195:   float: left;
1.808     droeschl 7196: }
                   7197: 
1.897     wenzelju 7198: ul#LC_secondary_menu li {
1.911     bisitz   7199:   font-weight: bold;
                   7200:   line-height: 1.8em;
1.1107    raeburn  7201:   border-right: 1px solid black;
                   7202:   float: left;
                   7203: }
                   7204: 
                   7205: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   7206:   background-color: $data_table_light;
                   7207: }
                   7208: 
                   7209: ul#LC_secondary_menu li a {
1.911     bisitz   7210:   padding: 0 0.8em;
1.1107    raeburn  7211: }
                   7212: 
                   7213: ul#LC_secondary_menu li ul {
                   7214:   display: none;
                   7215: }
                   7216: 
                   7217: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   7218:   display: block;
                   7219:   position: absolute;
                   7220:   margin: 0;
                   7221:   padding: 0;
                   7222:   list-style:none;
                   7223:   float: none;
                   7224:   background-color: $data_table_light;
                   7225:   z-index: 2;
                   7226:   margin-left: -1px;
                   7227: }
                   7228: 
                   7229: ul#LC_secondary_menu li ul li {
                   7230:   font-size: 90%;
                   7231:   vertical-align: top;
                   7232:   border-left: 1px solid black;
1.911     bisitz   7233:   border-right: 1px solid black;
1.1119    raeburn  7234:   background-color: $data_table_light;
1.1107    raeburn  7235:   list-style:none;
                   7236:   float: none;
                   7237: }
                   7238: 
                   7239: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   7240:   background-color: $data_table_dark;
1.807     droeschl 7241: }
                   7242: 
1.847     tempelho 7243: ul.LC_TabContent {
1.911     bisitz   7244:   display:block;
                   7245:   background: $sidebg;
                   7246:   border-bottom: solid 1px $lg_border_color;
                   7247:   list-style:none;
1.1020    raeburn  7248:   margin: -1px -10px 0 -10px;
1.911     bisitz   7249:   padding: 0;
1.693     droeschl 7250: }
                   7251: 
1.795     www      7252: ul.LC_TabContent li,
                   7253: ul.LC_TabContentBigger li {
1.911     bisitz   7254:   float:left;
1.741     harmsja  7255: }
1.795     www      7256: 
1.897     wenzelju 7257: ul#LC_secondary_menu li a {
1.911     bisitz   7258:   color: $fontmenu;
                   7259:   text-decoration: none;
1.693     droeschl 7260: }
1.795     www      7261: 
1.721     harmsja  7262: ul.LC_TabContent {
1.952     onken    7263:   min-height:20px;
1.721     harmsja  7264: }
1.795     www      7265: 
                   7266: ul.LC_TabContent li {
1.911     bisitz   7267:   vertical-align:middle;
1.959     onken    7268:   padding: 0 16px 0 10px;
1.911     bisitz   7269:   background-color:$tabbg;
                   7270:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  7271:   border-left: solid 1px $font;
1.721     harmsja  7272: }
1.795     www      7273: 
1.847     tempelho 7274: ul.LC_TabContent .right {
1.911     bisitz   7275:   float:right;
1.847     tempelho 7276: }
                   7277: 
1.911     bisitz   7278: ul.LC_TabContent li a,
                   7279: ul.LC_TabContent li {
                   7280:   color:rgb(47,47,47);
                   7281:   text-decoration:none;
                   7282:   font-size:95%;
                   7283:   font-weight:bold;
1.952     onken    7284:   min-height:20px;
                   7285: }
                   7286: 
1.959     onken    7287: ul.LC_TabContent li a:hover,
                   7288: ul.LC_TabContent li a:focus {
1.952     onken    7289:   color: $button_hover;
1.959     onken    7290:   background:none;
                   7291:   outline:none;
1.952     onken    7292: }
                   7293: 
                   7294: ul.LC_TabContent li:hover {
                   7295:   color: $button_hover;
                   7296:   cursor:pointer;
1.721     harmsja  7297: }
1.795     www      7298: 
1.911     bisitz   7299: ul.LC_TabContent li.active {
1.952     onken    7300:   color: $font;
1.911     bisitz   7301:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    7302:   border-bottom:solid 1px #FFFFFF;
                   7303:   cursor: default;
1.744     ehlerst  7304: }
1.795     www      7305: 
1.959     onken    7306: ul.LC_TabContent li.active a {
                   7307:   color:$font;
                   7308:   background:#FFFFFF;
                   7309:   outline: none;
                   7310: }
1.1047    raeburn  7311: 
                   7312: ul.LC_TabContent li.goback {
                   7313:   float: left;
                   7314:   border-left: none;
                   7315: }
                   7316: 
1.870     tempelho 7317: #maincoursedoc {
1.911     bisitz   7318:   clear:both;
1.870     tempelho 7319: }
                   7320: 
                   7321: ul.LC_TabContentBigger {
1.911     bisitz   7322:   display:block;
                   7323:   list-style:none;
                   7324:   padding: 0;
1.870     tempelho 7325: }
                   7326: 
1.795     www      7327: ul.LC_TabContentBigger li {
1.911     bisitz   7328:   vertical-align:bottom;
                   7329:   height: 30px;
                   7330:   font-size:110%;
                   7331:   font-weight:bold;
                   7332:   color: #737373;
1.841     tempelho 7333: }
                   7334: 
1.957     onken    7335: ul.LC_TabContentBigger li.active {
                   7336:   position: relative;
                   7337:   top: 1px;
                   7338: }
                   7339: 
1.870     tempelho 7340: ul.LC_TabContentBigger li a {
1.911     bisitz   7341:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   7342:   height: 30px;
                   7343:   line-height: 30px;
                   7344:   text-align: center;
                   7345:   display: block;
                   7346:   text-decoration: none;
1.958     onken    7347:   outline: none;  
1.741     harmsja  7348: }
1.795     www      7349: 
1.870     tempelho 7350: ul.LC_TabContentBigger li.active a {
1.911     bisitz   7351:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   7352:   color:$font;
1.744     ehlerst  7353: }
1.795     www      7354: 
1.870     tempelho 7355: ul.LC_TabContentBigger li b {
1.911     bisitz   7356:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7357:   display: block;
                   7358:   float: left;
                   7359:   padding: 0 30px;
1.957     onken    7360:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7361: }
                   7362: 
1.956     onken    7363: ul.LC_TabContentBigger li:hover b {
                   7364:   color:$button_hover;
                   7365: }
                   7366: 
1.870     tempelho 7367: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7368:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7369:   color:$font;
1.957     onken    7370:   border: 0;
1.741     harmsja  7371: }
1.693     droeschl 7372: 
1.870     tempelho 7373: 
1.862     bisitz   7374: ul.LC_CourseBreadcrumbs {
                   7375:   background: $sidebg;
1.1020    raeburn  7376:   height: 2em;
1.862     bisitz   7377:   padding-left: 10px;
1.1020    raeburn  7378:   margin: 0;
1.862     bisitz   7379:   list-style-position: inside;
                   7380: }
                   7381: 
1.911     bisitz   7382: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7383: ol#LC_PathBreadcrumbs {
1.911     bisitz   7384:   padding-left: 10px;
                   7385:   margin: 0;
1.933     droeschl 7386:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7387: }
                   7388: 
1.911     bisitz   7389: ol#LC_MenuBreadcrumbs li,
                   7390: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7391: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7392:   display: inline;
1.933     droeschl 7393:   white-space: normal;  
1.693     droeschl 7394: }
                   7395: 
1.823     bisitz   7396: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7397: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7398:   text-decoration: none;
                   7399:   font-size:90%;
1.693     droeschl 7400: }
1.795     www      7401: 
1.969     droeschl 7402: ol#LC_MenuBreadcrumbs h1 {
                   7403:   display: inline;
                   7404:   font-size: 90%;
                   7405:   line-height: 2.5em;
                   7406:   margin: 0;
                   7407:   padding: 0;
                   7408: }
                   7409: 
1.795     www      7410: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7411:   text-decoration:none;
                   7412:   font-size:100%;
                   7413:   font-weight:bold;
1.693     droeschl 7414: }
1.795     www      7415: 
1.840     bisitz   7416: .LC_Box {
1.911     bisitz   7417:   border: solid 1px $lg_border_color;
                   7418:   padding: 0 10px 10px 10px;
1.746     neumanie 7419: }
1.795     www      7420: 
1.1020    raeburn  7421: .LC_DocsBox {
                   7422:   border: solid 1px $lg_border_color;
                   7423:   padding: 0 0 10px 10px;
                   7424: }
                   7425: 
1.795     www      7426: .LC_AboutMe_Image {
1.911     bisitz   7427:   float:left;
                   7428:   margin-right:10px;
1.747     neumanie 7429: }
1.795     www      7430: 
                   7431: .LC_Clear_AboutMe_Image {
1.911     bisitz   7432:   clear:left;
1.747     neumanie 7433: }
1.795     www      7434: 
1.721     harmsja  7435: dl.LC_ListStyleClean dt {
1.911     bisitz   7436:   padding-right: 5px;
                   7437:   display: table-header-group;
1.693     droeschl 7438: }
                   7439: 
1.721     harmsja  7440: dl.LC_ListStyleClean dd {
1.911     bisitz   7441:   display: table-row;
1.693     droeschl 7442: }
                   7443: 
1.721     harmsja  7444: .LC_ListStyleClean,
                   7445: .LC_ListStyleSimple,
                   7446: .LC_ListStyleNormal,
1.795     www      7447: .LC_ListStyleSpecial {
1.911     bisitz   7448:   /* display:block; */
                   7449:   list-style-position: inside;
                   7450:   list-style-type: none;
                   7451:   overflow: hidden;
                   7452:   padding: 0;
1.693     droeschl 7453: }
                   7454: 
1.721     harmsja  7455: .LC_ListStyleSimple li,
                   7456: .LC_ListStyleSimple dd,
                   7457: .LC_ListStyleNormal li,
                   7458: .LC_ListStyleNormal dd,
                   7459: .LC_ListStyleSpecial li,
1.795     www      7460: .LC_ListStyleSpecial dd {
1.911     bisitz   7461:   margin: 0;
                   7462:   padding: 5px 5px 5px 10px;
                   7463:   clear: both;
1.693     droeschl 7464: }
                   7465: 
1.721     harmsja  7466: .LC_ListStyleClean li,
                   7467: .LC_ListStyleClean dd {
1.911     bisitz   7468:   padding-top: 0;
                   7469:   padding-bottom: 0;
1.693     droeschl 7470: }
                   7471: 
1.721     harmsja  7472: .LC_ListStyleSimple dd,
1.795     www      7473: .LC_ListStyleSimple li {
1.911     bisitz   7474:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7475: }
                   7476: 
1.721     harmsja  7477: .LC_ListStyleSpecial li,
                   7478: .LC_ListStyleSpecial dd {
1.911     bisitz   7479:   list-style-type: none;
                   7480:   background-color: RGB(220, 220, 220);
                   7481:   margin-bottom: 4px;
1.693     droeschl 7482: }
                   7483: 
1.721     harmsja  7484: table.LC_SimpleTable {
1.911     bisitz   7485:   margin:5px;
                   7486:   border:solid 1px $lg_border_color;
1.795     www      7487: }
1.693     droeschl 7488: 
1.721     harmsja  7489: table.LC_SimpleTable tr {
1.911     bisitz   7490:   padding: 0;
                   7491:   border:solid 1px $lg_border_color;
1.693     droeschl 7492: }
1.795     www      7493: 
                   7494: table.LC_SimpleTable thead {
1.911     bisitz   7495:   background:rgb(220,220,220);
1.693     droeschl 7496: }
                   7497: 
1.721     harmsja  7498: div.LC_columnSection {
1.911     bisitz   7499:   display: block;
                   7500:   clear: both;
                   7501:   overflow: hidden;
                   7502:   margin: 0;
1.693     droeschl 7503: }
                   7504: 
1.721     harmsja  7505: div.LC_columnSection>* {
1.911     bisitz   7506:   float: left;
                   7507:   margin: 10px 20px 10px 0;
                   7508:   overflow:hidden;
1.693     droeschl 7509: }
1.721     harmsja  7510: 
1.795     www      7511: table em {
1.911     bisitz   7512:   font-weight: bold;
                   7513:   font-style: normal;
1.748     schulted 7514: }
1.795     www      7515: 
1.779     bisitz   7516: table.LC_tableBrowseRes,
1.795     www      7517: table.LC_tableOfContent {
1.911     bisitz   7518:   border:none;
                   7519:   border-spacing: 1px;
                   7520:   padding: 3px;
                   7521:   background-color: #FFFFFF;
                   7522:   font-size: 90%;
1.753     droeschl 7523: }
1.789     droeschl 7524: 
1.911     bisitz   7525: table.LC_tableOfContent {
                   7526:   border-collapse: collapse;
1.789     droeschl 7527: }
                   7528: 
1.771     droeschl 7529: table.LC_tableBrowseRes a,
1.768     schulted 7530: table.LC_tableOfContent a {
1.911     bisitz   7531:   background-color: transparent;
                   7532:   text-decoration: none;
1.753     droeschl 7533: }
                   7534: 
1.795     www      7535: table.LC_tableOfContent img {
1.911     bisitz   7536:   border: none;
                   7537:   height: 1.3em;
                   7538:   vertical-align: text-bottom;
                   7539:   margin-right: 0.3em;
1.753     droeschl 7540: }
1.757     schulted 7541: 
1.795     www      7542: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7543:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7544: }
                   7545: 
1.795     www      7546: a#LC_content_toolbar_everything {
1.911     bisitz   7547:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7548: }
                   7549: 
1.795     www      7550: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7551:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7552: }
                   7553: 
1.795     www      7554: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7555:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7556: }
                   7557: 
1.795     www      7558: a#LC_content_toolbar_changefolder {
1.911     bisitz   7559:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7560: }
                   7561: 
1.795     www      7562: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7563:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7564: }
                   7565: 
1.1043    raeburn  7566: a#LC_content_toolbar_edittoplevel {
                   7567:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7568: }
                   7569: 
1.795     www      7570: ul#LC_toolbar li a:hover {
1.911     bisitz   7571:   background-position: bottom center;
1.757     schulted 7572: }
                   7573: 
1.795     www      7574: ul#LC_toolbar {
1.911     bisitz   7575:   padding: 0;
                   7576:   margin: 2px;
                   7577:   list-style:none;
                   7578:   position:relative;
                   7579:   background-color:white;
1.1082    raeburn  7580:   overflow: auto;
1.757     schulted 7581: }
                   7582: 
1.795     www      7583: ul#LC_toolbar li {
1.911     bisitz   7584:   border:1px solid white;
                   7585:   padding: 0;
                   7586:   margin: 0;
                   7587:   float: left;
                   7588:   display:inline;
                   7589:   vertical-align:middle;
1.1082    raeburn  7590:   white-space: nowrap;
1.911     bisitz   7591: }
1.757     schulted 7592: 
1.783     amueller 7593: 
1.795     www      7594: a.LC_toolbarItem {
1.911     bisitz   7595:   display:block;
                   7596:   padding: 0;
                   7597:   margin: 0;
                   7598:   height: 32px;
                   7599:   width: 32px;
                   7600:   color:white;
                   7601:   border: none;
                   7602:   background-repeat:no-repeat;
                   7603:   background-color:transparent;
1.757     schulted 7604: }
                   7605: 
1.915     droeschl 7606: ul.LC_funclist {
                   7607:     margin: 0;
                   7608:     padding: 0.5em 1em 0.5em 0;
                   7609: }
                   7610: 
1.933     droeschl 7611: ul.LC_funclist > li:first-child {
                   7612:     font-weight:bold; 
                   7613:     margin-left:0.8em;
                   7614: }
                   7615: 
1.915     droeschl 7616: ul.LC_funclist + ul.LC_funclist {
                   7617:     /* 
                   7618:        left border as a seperator if we have more than
                   7619:        one list 
                   7620:     */
                   7621:     border-left: 1px solid $sidebg;
                   7622:     /* 
                   7623:        this hides the left border behind the border of the 
                   7624:        outer box if element is wrapped to the next 'line' 
                   7625:     */
                   7626:     margin-left: -1px;
                   7627: }
                   7628: 
1.843     bisitz   7629: ul.LC_funclist li {
1.915     droeschl 7630:   display: inline;
1.782     bisitz   7631:   white-space: nowrap;
1.915     droeschl 7632:   margin: 0 0 0 25px;
                   7633:   line-height: 150%;
1.782     bisitz   7634: }
                   7635: 
1.974     wenzelju 7636: .LC_hidden {
                   7637:   display: none;
                   7638: }
                   7639: 
1.1030    www      7640: .LCmodal-overlay {
                   7641: 		position:fixed;
                   7642: 		top:0;
                   7643: 		right:0;
                   7644: 		bottom:0;
                   7645: 		left:0;
                   7646: 		height:100%;
                   7647: 		width:100%;
                   7648: 		margin:0;
                   7649: 		padding:0;
                   7650: 		background:#999;
                   7651: 		opacity:.75;
                   7652: 		filter: alpha(opacity=75);
                   7653: 		-moz-opacity: 0.75;
                   7654: 		z-index:101;
                   7655: }
                   7656: 
                   7657: * html .LCmodal-overlay {   
                   7658: 		position: absolute;
                   7659: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7660: }
                   7661: 
                   7662: .LCmodal-window {
                   7663: 		position:fixed;
                   7664: 		top:50%;
                   7665: 		left:50%;
                   7666: 		margin:0;
                   7667: 		padding:0;
                   7668: 		z-index:102;
                   7669: 	}
                   7670: 
                   7671: * html .LCmodal-window {
                   7672: 		position:absolute;
                   7673: }
                   7674: 
                   7675: .LCclose-window {
                   7676: 		position:absolute;
                   7677: 		width:32px;
                   7678: 		height:32px;
                   7679: 		right:8px;
                   7680: 		top:8px;
                   7681: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7682: 		text-indent:-99999px;
                   7683: 		overflow:hidden;
                   7684: 		cursor:pointer;
                   7685: }
                   7686: 
1.1100    raeburn  7687: /*
1.1231    damieng  7688:   styles used for response display
                   7689: */
                   7690: div.LC_radiofoil, div.LC_rankfoil {
                   7691:   margin: .5em 0em .5em 0em;
                   7692: }
                   7693: table.LC_itemgroup {
                   7694:   margin-top: 1em;
                   7695: }
                   7696: 
                   7697: /*
1.1100    raeburn  7698:   styles used by TTH when "Default set of options to pass to tth/m
                   7699:   when converting TeX" in course settings has been set
                   7700: 
                   7701:   option passed: -t
                   7702: 
                   7703: */
                   7704: 
                   7705: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7706: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7707: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7708: td div.norm {line-height:normal;}
                   7709: 
                   7710: /*
                   7711:   option passed -y3
                   7712: */
                   7713: 
                   7714: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7715: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7716: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7717: 
1.1230    damieng  7718: /*
                   7719:   sections with roles, for content only
                   7720: */
                   7721: section[class^="role-"] {
                   7722:   padding-left: 10px;
                   7723:   padding-right: 5px;
                   7724:   margin-top: 8px;
                   7725:   margin-bottom: 8px;
                   7726:   border: 1px solid #2A4;
                   7727:   border-radius: 5px;
                   7728:   box-shadow: 0px 1px 1px #BBB;
                   7729: }
                   7730: section[class^="role-"]>h1 {
                   7731:   position: relative;
                   7732:   margin: 0px;
                   7733:   padding-top: 10px;
                   7734:   padding-left: 40px;
                   7735: }
                   7736: section[class^="role-"]>h1:before {
                   7737:   position: absolute;
                   7738:   left: -5px;
                   7739:   top: 5px;
                   7740: }
                   7741: section.role-activity>h1:before {
                   7742:   content:url('/adm/daxe/images/section_icons/activity.png');
                   7743: }
                   7744: section.role-advice>h1:before {
                   7745:   content:url('/adm/daxe/images/section_icons/advice.png');
                   7746: }
                   7747: section.role-bibliography>h1:before {
                   7748:   content:url('/adm/daxe/images/section_icons/bibliography.png');
                   7749: }
                   7750: section.role-citation>h1:before {
                   7751:   content:url('/adm/daxe/images/section_icons/citation.png');
                   7752: }
                   7753: section.role-conclusion>h1:before {
                   7754:   content:url('/adm/daxe/images/section_icons/conclusion.png');
                   7755: }
                   7756: section.role-definition>h1:before {
                   7757:   content:url('/adm/daxe/images/section_icons/definition.png');
                   7758: }
                   7759: section.role-demonstration>h1:before {
                   7760:   content:url('/adm/daxe/images/section_icons/demonstration.png');
                   7761: }
                   7762: section.role-example>h1:before {
                   7763:   content:url('/adm/daxe/images/section_icons/example.png');
                   7764: }
                   7765: section.role-explanation>h1:before {
                   7766:   content:url('/adm/daxe/images/section_icons/explanation.png');
                   7767: }
                   7768: section.role-introduction>h1:before {
                   7769:   content:url('/adm/daxe/images/section_icons/introduction.png');
                   7770: }
                   7771: section.role-method>h1:before {
                   7772:   content:url('/adm/daxe/images/section_icons/method.png');
                   7773: }
                   7774: section.role-more_information>h1:before {
                   7775:   content:url('/adm/daxe/images/section_icons/more_information.png');
                   7776: }
                   7777: section.role-objectives>h1:before {
                   7778:   content:url('/adm/daxe/images/section_icons/objectives.png');
                   7779: }
                   7780: section.role-prerequisites>h1:before {
                   7781:   content:url('/adm/daxe/images/section_icons/prerequisites.png');
                   7782: }
                   7783: section.role-remark>h1:before {
                   7784:   content:url('/adm/daxe/images/section_icons/remark.png');
                   7785: }
                   7786: section.role-reminder>h1:before {
                   7787:   content:url('/adm/daxe/images/section_icons/reminder.png');
                   7788: }
                   7789: section.role-summary>h1:before {
                   7790:   content:url('/adm/daxe/images/section_icons/summary.png');
                   7791: }
                   7792: section.role-syntax>h1:before {
                   7793:   content:url('/adm/daxe/images/section_icons/syntax.png');
                   7794: }
                   7795: section.role-warning>h1:before {
                   7796:   content:url('/adm/daxe/images/section_icons/warning.png');
                   7797: }
                   7798: 
1.343     albertel 7799: END
                   7800: }
                   7801: 
1.306     albertel 7802: =pod
                   7803: 
                   7804: =item * &headtag()
                   7805: 
                   7806: Returns a uniform footer for LON-CAPA web pages.
                   7807: 
1.307     albertel 7808: Inputs: $title - optional title for the head
                   7809:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7810:         $args - optional arguments
1.319     albertel 7811:             force_register - if is true call registerurl so the remote is 
                   7812:                              informed
1.415     albertel 7813:             redirect       -> array ref of
                   7814:                                    1- seconds before redirect occurs
                   7815:                                    2- url to redirect to
                   7816:                                    3- whether the side effect should occur
1.315     albertel 7817:                            (side effect of setting 
                   7818:                                $env{'internal.head.redirect'} to the url 
                   7819:                                redirected too)
1.352     albertel 7820:             domain         -> force to color decorate a page for a specific
                   7821:                                domain
                   7822:             function       -> force usage of a specific rolish color scheme
                   7823:             bgcolor        -> override the default page bgcolor
1.460     albertel 7824:             no_auto_mt_title
                   7825:                            -> prevent &mt()ing the title arg
1.464     albertel 7826: 
1.306     albertel 7827: =cut
                   7828: 
                   7829: sub headtag {
1.313     albertel 7830:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7831:     
1.363     albertel 7832:     my $function = $args->{'function'} || &get_users_function();
                   7833:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7834:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  7835:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7836:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7837: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7838: 		   #time(),
1.418     albertel 7839: 		   $env{'environment.color.timestamp'},
1.363     albertel 7840: 		   $function,$domain,$bgcolor);
                   7841: 
1.369     www      7842:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7843: 
1.308     albertel 7844:     my $result =
                   7845: 	'<head>'.
1.1160    raeburn  7846: 	&font_settings($args);
1.319     albertel 7847: 
1.1188    raeburn  7848:     my $inhibitprint;
                   7849:     if ($args->{'print_suppress'}) {
                   7850:         $inhibitprint = &print_suppression();
                   7851:     }
1.1064    raeburn  7852: 
1.461     albertel 7853:     if (!$args->{'frameset'}) {
                   7854: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7855:     }
1.962     droeschl 7856:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7857:         $result .= Apache::lonxml::display_title();
1.319     albertel 7858:     }
1.436     albertel 7859:     if (!$args->{'no_nav_bar'} 
                   7860: 	&& !$args->{'only_body'}
                   7861: 	&& !$args->{'frameset'}) {
1.1154    raeburn  7862: 	$result .= &help_menu_js($httphost);
1.1032    www      7863:         $result.=&modal_window();
1.1038    www      7864:         $result.=&togglebox_script();
1.1034    www      7865:         $result.=&wishlist_window();
1.1041    www      7866:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7867:     } else {
                   7868:         if ($args->{'add_modal'}) {
                   7869:            $result.=&modal_window();
                   7870:         }
                   7871:         if ($args->{'add_wishlist'}) {
                   7872:            $result.=&wishlist_window();
                   7873:         }
1.1038    www      7874:         if ($args->{'add_togglebox'}) {
                   7875:            $result.=&togglebox_script();
                   7876:         }
1.1041    www      7877:         if ($args->{'add_progressbar'}) {
                   7878:            $result.=&LCprogressbarUpdate_script();
                   7879:         }
1.436     albertel 7880:     }
1.314     albertel 7881:     if (ref($args->{'redirect'})) {
1.414     albertel 7882: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7883: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7884: 	if (!$inhibit_continue) {
                   7885: 	    $env{'internal.head.redirect'} = $url;
                   7886: 	}
1.313     albertel 7887: 	$result.=<<ADDMETA
                   7888: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7889: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7890: ADDMETA
1.1210    raeburn  7891:     } else {
                   7892:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   7893:             my $requrl = $env{'request.uri'};
                   7894:             if ($requrl eq '') {
                   7895:                 $requrl = $ENV{'REQUEST_URI'};
                   7896:                 $requrl =~ s/\?.+$//;
                   7897:             }
                   7898:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   7899:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   7900:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   7901:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   7902:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   7903:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                   7904:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   7905:                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   7906:                         if ($domdefs{'offloadnow'}{$lonhost}) {
                   7907:                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                   7908:                             if (($newserver) && ($newserver ne $lonhost)) {
                   7909:                                 my $numsec = 5;
                   7910:                                 my $timeout = $numsec * 1000;
                   7911:                                 my ($newurl,$locknum,%locks,$msg);
                   7912:                                 if ($env{'request.role.adv'}) {
                   7913:                                     ($locknum,%locks) = &Apache::lonnet::get_locks();
                   7914:                                 }
                   7915:                                 my $disable_submit = 0;
                   7916:                                 if ($requrl =~ /$LONCAPA::assess_re/) {
                   7917:                                     $disable_submit = 1;
                   7918:                                 }
                   7919:                                 if ($locknum) {
                   7920:                                     my @lockinfo = sort(values(%locks));
                   7921:                                     $msg = &mt('Once the following tasks are complete: ')."\\n".
                   7922:                                            join(", ",sort(values(%locks)))."\\n".
                   7923:                                            &mt('your session will be transferred to a different server, after you click "Roles".');
                   7924:                                 } else {
                   7925:                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   7926:                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                   7927:                                     }
                   7928:                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   7929:                                     $newurl = '/adm/switchserver?otherserver='.$newserver;
                   7930:                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   7931:                                         $newurl .= '&role='.$env{'request.role'};
                   7932:                                     }
                   7933:                                     if ($env{'request.symb'}) {
                   7934:                                         $newurl .= '&symb='.$env{'request.symb'};
                   7935:                                     } else {
                   7936:                                         $newurl .= '&origurl='.$requrl;
                   7937:                                     }
                   7938:                                 }
1.1222    damieng  7939:                                 &js_escape(\$msg);
1.1210    raeburn  7940:                                 $result.=<<OFFLOAD
                   7941: <meta http-equiv="pragma" content="no-cache" />
                   7942: <script type="text/javascript">
1.1215    raeburn  7943: // <![CDATA[
1.1210    raeburn  7944: function LC_Offload_Now() {
                   7945:     var dest = "$newurl";
                   7946:     if (dest != '') {
                   7947:         window.location.href="$newurl";
                   7948:     }
                   7949: }
1.1214    raeburn  7950: \$(document).ready(function () {
                   7951:     window.alert('$msg');
                   7952:     if ($disable_submit) {
1.1210    raeburn  7953:         \$(".LC_hwk_submit").prop("disabled", true);
                   7954:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214    raeburn  7955:     }
                   7956:     setTimeout('LC_Offload_Now()', $timeout);
                   7957: });
1.1215    raeburn  7958: // ]]>
1.1210    raeburn  7959: </script>
                   7960: OFFLOAD
                   7961:                             }
                   7962:                         }
                   7963:                     }
                   7964:                 }
                   7965:             }
                   7966:         }
1.313     albertel 7967:     }
1.306     albertel 7968:     if (!defined($title)) {
                   7969: 	$title = 'The LearningOnline Network with CAPA';
                   7970:     }
1.460     albertel 7971:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7972:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  7973: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7974:     if (!$args->{'frameset'}) {
                   7975:         $result .= ' /';
                   7976:     }
                   7977:     $result .= '>' 
1.1064    raeburn  7978:         .$inhibitprint
1.414     albertel 7979: 	.$head_extra;
1.1242    raeburn  7980:     my $clientmobile;
                   7981:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   7982:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   7983:     } else {
                   7984:         $clientmobile = $env{'browser.mobile'};
                   7985:     }
                   7986:     if ($clientmobile) {
1.1137    raeburn  7987:         $result .= '
                   7988: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7989: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7990:     }
1.962     droeschl 7991:     return $result.'</head>';
1.306     albertel 7992: }
                   7993: 
                   7994: =pod
                   7995: 
1.340     albertel 7996: =item * &font_settings()
                   7997: 
                   7998: Returns neccessary <meta> to set the proper encoding
                   7999: 
1.1160    raeburn  8000: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 8001: 
                   8002: =cut
                   8003: 
                   8004: sub font_settings {
1.1160    raeburn  8005:     my ($args) = @_;
1.340     albertel 8006:     my $headerstring='';
1.1160    raeburn  8007:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   8008:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  8009:         $headerstring.=
                   8010:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   8011:         if (!$args->{'frameset'}) {
                   8012: 	    $headerstring.= ' /';
                   8013:         }
                   8014: 	$headerstring .= '>'."\n";
1.340     albertel 8015:     }
                   8016:     return $headerstring;
                   8017: }
                   8018: 
1.341     albertel 8019: =pod
                   8020: 
1.1064    raeburn  8021: =item * &print_suppression()
                   8022: 
                   8023: In course context returns css which causes the body to be blank when media="print",
                   8024: if printout generation is unavailable for the current resource.
                   8025: 
                   8026: This could be because:
                   8027: 
                   8028: (a) printstartdate is in the future
                   8029: 
                   8030: (b) printenddate is in the past
                   8031: 
                   8032: (c) there is an active exam block with "printout"
                   8033: functionality blocked
                   8034: 
                   8035: Users with pav, pfo or evb privileges are exempt.
                   8036: 
                   8037: Inputs: none
                   8038: 
                   8039: =cut
                   8040: 
                   8041: 
                   8042: sub print_suppression {
                   8043:     my $noprint;
                   8044:     if ($env{'request.course.id'}) {
                   8045:         my $scope = $env{'request.course.id'};
                   8046:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8047:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   8048:             return;
                   8049:         }
                   8050:         if ($env{'request.course.sec'} ne '') {
                   8051:             $scope .= "/$env{'request.course.sec'}";
                   8052:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8053:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  8054:                 return;
1.1064    raeburn  8055:             }
                   8056:         }
                   8057:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8058:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189    raeburn  8059:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  8060:         if ($blocked) {
                   8061:             my $checkrole = "cm./$cdom/$cnum";
                   8062:             if ($env{'request.course.sec'} ne '') {
                   8063:                 $checkrole .= "/$env{'request.course.sec'}";
                   8064:             }
                   8065:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   8066:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   8067:                 $noprint = 1;
                   8068:             }
                   8069:         }
                   8070:         unless ($noprint) {
                   8071:             my $symb = &Apache::lonnet::symbread();
                   8072:             if ($symb ne '') {
                   8073:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   8074:                 if (ref($navmap)) {
                   8075:                     my $res = $navmap->getBySymb($symb);
                   8076:                     if (ref($res)) {
                   8077:                         if (!$res->resprintable()) {
                   8078:                             $noprint = 1;
                   8079:                         }
                   8080:                     }
                   8081:                 }
                   8082:             }
                   8083:         }
                   8084:         if ($noprint) {
                   8085:             return <<"ENDSTYLE";
                   8086: <style type="text/css" media="print">
                   8087:     body { display:none }
                   8088: </style>
                   8089: ENDSTYLE
                   8090:         }
                   8091:     }
                   8092:     return;
                   8093: }
                   8094: 
                   8095: =pod
                   8096: 
1.341     albertel 8097: =item * &xml_begin()
                   8098: 
                   8099: Returns the needed doctype and <html>
                   8100: 
                   8101: Inputs: none
                   8102: 
                   8103: =cut
                   8104: 
                   8105: sub xml_begin {
1.1168    raeburn  8106:     my ($is_frameset) = @_;
1.341     albertel 8107:     my $output='';
                   8108: 
                   8109:     if ($env{'browser.mathml'}) {
                   8110: 	$output='<?xml version="1.0"?>'
                   8111:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   8112: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   8113:             
                   8114: #	    .'<!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">] >'
                   8115: 	    .'<!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">'
                   8116:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   8117: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  8118:     } elsif ($is_frameset) {
                   8119:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   8120:                 '<html>'."\n";
1.341     albertel 8121:     } else {
1.1168    raeburn  8122: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   8123:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 8124:     }
                   8125:     return $output;
                   8126: }
1.340     albertel 8127: 
                   8128: =pod
                   8129: 
1.306     albertel 8130: =item * &start_page()
                   8131: 
                   8132: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   8133: 
1.648     raeburn  8134: Inputs:
                   8135: 
                   8136: =over 4
                   8137: 
                   8138: $title - optional title for the page
                   8139: 
                   8140: $head_extra - optional extra HTML to incude inside the <head>
                   8141: 
                   8142: $args - additional optional args supported are:
                   8143: 
                   8144: =over 8
                   8145: 
                   8146:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 8147:                                     arg on
1.814     bisitz   8148:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  8149:              add_entries    -> additional attributes to add to the  <body>
                   8150:              domain         -> force to color decorate a page for a 
1.317     albertel 8151:                                     specific domain
1.648     raeburn  8152:              function       -> force usage of a specific rolish color
1.317     albertel 8153:                                     scheme
1.648     raeburn  8154:              redirect       -> see &headtag()
                   8155:              bgcolor        -> override the default page bg color
                   8156:              js_ready       -> return a string ready for being used in 
1.317     albertel 8157:                                     a javascript writeln
1.648     raeburn  8158:              html_encode    -> return a string ready for being used in 
1.320     albertel 8159:                                     a html attribute
1.648     raeburn  8160:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 8161:                                     $forcereg arg
1.648     raeburn  8162:              frameset       -> if true will start with a <frameset>
1.330     albertel 8163:                                     rather than <body>
1.648     raeburn  8164:              skip_phases    -> hash ref of 
1.338     albertel 8165:                                     head -> skip the <html><head> generation
                   8166:                                     body -> skip all <body> generation
1.648     raeburn  8167:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 8168:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  8169:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  8170:              group          -> includes the current group, if page is for a 
                   8171:                                specific group  
1.361     albertel 8172: 
1.648     raeburn  8173: =back
1.460     albertel 8174: 
1.648     raeburn  8175: =back
1.562     albertel 8176: 
1.306     albertel 8177: =cut
                   8178: 
                   8179: sub start_page {
1.309     albertel 8180:     my ($title,$head_extra,$args) = @_;
1.318     albertel 8181:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 8182: 
1.315     albertel 8183:     $env{'internal.start_page'}++;
1.1096    raeburn  8184:     my ($result,@advtools);
1.964     droeschl 8185: 
1.338     albertel 8186:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  8187:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 8188:     }
                   8189:     
                   8190:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   8191: 	if ($args->{'frameset'}) {
                   8192: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   8193: 						$args->{'add_entries'});
                   8194: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   8195:         } else {
                   8196:             $result .=
                   8197:                 &bodytag($title, 
                   8198:                          $args->{'function'},       $args->{'add_entries'},
                   8199:                          $args->{'only_body'},      $args->{'domain'},
                   8200:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  8201:                          $args->{'bgcolor'},        $args,
                   8202:                          \@advtools);
1.831     bisitz   8203:         }
1.330     albertel 8204:     }
1.338     albertel 8205: 
1.315     albertel 8206:     if ($args->{'js_ready'}) {
1.713     kaisler  8207: 		$result = &js_ready($result);
1.315     albertel 8208:     }
1.320     albertel 8209:     if ($args->{'html_encode'}) {
1.713     kaisler  8210: 		$result = &html_encode($result);
                   8211:     }
                   8212: 
1.813     bisitz   8213:     # Preparation for new and consistent functionlist at top of screen
                   8214:     # if ($args->{'functionlist'}) {
                   8215:     #            $result .= &build_functionlist();
                   8216:     #}
                   8217: 
1.964     droeschl 8218:     # Don't add anything more if only_body wanted or in const space
                   8219:     return $result if    $args->{'only_body'} 
                   8220:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   8221: 
                   8222:     #Breadcrumbs
1.758     kaisler  8223:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   8224: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   8225: 		#if any br links exists, add them to the breadcrumbs
                   8226: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   8227: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   8228: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   8229: 			}
                   8230: 		}
1.1096    raeburn  8231:                 # if @advtools array contains items add then to the breadcrumbs
                   8232:                 if (@advtools > 0) {
                   8233:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   8234:                 }
1.758     kaisler  8235: 
                   8236: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   8237: 		if(exists($args->{'bread_crumbs_component'})){
                   8238: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.1237    raeburn  8239: 		} elsif ($args->{'crstype'} eq 'Placement') {
                   8240: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
                   8241:                                                                        $args->{'crstype'});
                   8242:                 } else {
1.758     kaisler  8243: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   8244: 		}
1.320     albertel 8245:     }
1.315     albertel 8246:     return $result;
1.306     albertel 8247: }
                   8248: 
                   8249: sub end_page {
1.315     albertel 8250:     my ($args) = @_;
                   8251:     $env{'internal.end_page'}++;
1.330     albertel 8252:     my $result;
1.335     albertel 8253:     if ($args->{'discussion'}) {
                   8254: 	my ($target,$parser);
                   8255: 	if (ref($args->{'discussion'})) {
                   8256: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   8257: 				$args->{'discussion'}{'parser'});
                   8258: 	}
                   8259: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   8260:     }
1.330     albertel 8261:     if ($args->{'frameset'}) {
                   8262: 	$result .= '</frameset>';
                   8263:     } else {
1.635     raeburn  8264: 	$result .= &endbodytag($args);
1.330     albertel 8265:     }
1.1080    raeburn  8266:     unless ($args->{'notbody'}) {
                   8267:         $result .= "\n</html>";
                   8268:     }
1.330     albertel 8269: 
1.315     albertel 8270:     if ($args->{'js_ready'}) {
1.317     albertel 8271: 	$result = &js_ready($result);
1.315     albertel 8272:     }
1.335     albertel 8273: 
1.320     albertel 8274:     if ($args->{'html_encode'}) {
                   8275: 	$result = &html_encode($result);
                   8276:     }
1.335     albertel 8277: 
1.315     albertel 8278:     return $result;
                   8279: }
                   8280: 
1.1034    www      8281: sub wishlist_window {
                   8282:     return(<<'ENDWISHLIST');
1.1046    raeburn  8283: <script type="text/javascript">
1.1034    www      8284: // <![CDATA[
                   8285: // <!-- BEGIN LON-CAPA Internal
                   8286: function set_wishlistlink(title, path) {
                   8287:     if (!title) {
                   8288:         title = document.title;
                   8289:         title = title.replace(/^LON-CAPA /,'');
                   8290:     }
1.1175    raeburn  8291:     title = encodeURIComponent(title);
1.1203    raeburn  8292:     title = title.replace("'","\\\'");
1.1034    www      8293:     if (!path) {
                   8294:         path = location.pathname;
                   8295:     }
1.1175    raeburn  8296:     path = encodeURIComponent(path);
1.1203    raeburn  8297:     path = path.replace("'","\\\'");
1.1034    www      8298:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   8299:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   8300: }
                   8301: // END LON-CAPA Internal -->
                   8302: // ]]>
                   8303: </script>
                   8304: ENDWISHLIST
                   8305: }
                   8306: 
1.1030    www      8307: sub modal_window {
                   8308:     return(<<'ENDMODAL');
1.1046    raeburn  8309: <script type="text/javascript">
1.1030    www      8310: // <![CDATA[
                   8311: // <!-- BEGIN LON-CAPA Internal
                   8312: var modalWindow = {
                   8313: 	parent:"body",
                   8314: 	windowId:null,
                   8315: 	content:null,
                   8316: 	width:null,
                   8317: 	height:null,
                   8318: 	close:function()
                   8319: 	{
                   8320: 	        $(".LCmodal-window").remove();
                   8321: 	        $(".LCmodal-overlay").remove();
                   8322: 	},
                   8323: 	open:function()
                   8324: 	{
                   8325: 		var modal = "";
                   8326: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   8327: 		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;\">";
                   8328: 		modal += this.content;
                   8329: 		modal += "</div>";	
                   8330: 
                   8331: 		$(this.parent).append(modal);
                   8332: 
                   8333: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   8334: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   8335: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   8336: 	}
                   8337: };
1.1140    raeburn  8338: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      8339: 	{
1.1203    raeburn  8340:                 source = source.replace("'","&#39;");
1.1030    www      8341: 		modalWindow.windowId = "myModal";
                   8342: 		modalWindow.width = width;
                   8343: 		modalWindow.height = height;
1.1196    raeburn  8344: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      8345: 		modalWindow.open();
1.1208    raeburn  8346: 	};
1.1030    www      8347: // END LON-CAPA Internal -->
                   8348: // ]]>
                   8349: </script>
                   8350: ENDMODAL
                   8351: }
                   8352: 
                   8353: sub modal_link {
1.1140    raeburn  8354:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      8355:     unless ($width) { $width=480; }
                   8356:     unless ($height) { $height=400; }
1.1031    www      8357:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  8358:     unless ($transparency) { $transparency='true'; }
                   8359: 
1.1074    raeburn  8360:     my $target_attr;
                   8361:     if (defined($target)) {
                   8362:         $target_attr = 'target="'.$target.'"';
                   8363:     }
                   8364:     return <<"ENDLINK";
1.1140    raeburn  8365: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  8366:            $linktext</a>
                   8367: ENDLINK
1.1030    www      8368: }
                   8369: 
1.1032    www      8370: sub modal_adhoc_script {
                   8371:     my ($funcname,$width,$height,$content)=@_;
                   8372:     return (<<ENDADHOC);
1.1046    raeburn  8373: <script type="text/javascript">
1.1032    www      8374: // <![CDATA[
                   8375:         var $funcname = function()
                   8376:         {
                   8377:                 modalWindow.windowId = "myModal";
                   8378:                 modalWindow.width = $width;
                   8379:                 modalWindow.height = $height;
                   8380:                 modalWindow.content = '$content';
                   8381:                 modalWindow.open();
                   8382:         };  
                   8383: // ]]>
                   8384: </script>
                   8385: ENDADHOC
                   8386: }
                   8387: 
1.1041    www      8388: sub modal_adhoc_inner {
                   8389:     my ($funcname,$width,$height,$content)=@_;
                   8390:     my $innerwidth=$width-20;
                   8391:     $content=&js_ready(
1.1140    raeburn  8392:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   8393:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   8394:                  $content.
1.1041    www      8395:                  &end_scrollbox().
1.1140    raeburn  8396:                  &end_page()
1.1041    www      8397:              );
                   8398:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   8399: }
                   8400: 
                   8401: sub modal_adhoc_window {
                   8402:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   8403:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   8404:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   8405: }
                   8406: 
                   8407: sub modal_adhoc_launch {
                   8408:     my ($funcname,$width,$height,$content)=@_;
                   8409:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   8410: <script type="text/javascript">
                   8411: // <![CDATA[
                   8412: $funcname();
                   8413: // ]]>
                   8414: </script>
                   8415: ENDLAUNCH
                   8416: }
                   8417: 
                   8418: sub modal_adhoc_close {
                   8419:     return (<<ENDCLOSE);
                   8420: <script type="text/javascript">
                   8421: // <![CDATA[
                   8422: modalWindow.close();
                   8423: // ]]>
                   8424: </script>
                   8425: ENDCLOSE
                   8426: }
                   8427: 
1.1038    www      8428: sub togglebox_script {
                   8429:    return(<<ENDTOGGLE);
                   8430: <script type="text/javascript"> 
                   8431: // <![CDATA[
                   8432: function LCtoggleDisplay(id,hidetext,showtext) {
                   8433:    link = document.getElementById(id + "link").childNodes[0];
                   8434:    with (document.getElementById(id).style) {
                   8435:       if (display == "none" ) {
                   8436:           display = "inline";
                   8437:           link.nodeValue = hidetext;
                   8438:         } else {
                   8439:           display = "none";
                   8440:           link.nodeValue = showtext;
                   8441:        }
                   8442:    }
                   8443: }
                   8444: // ]]>
                   8445: </script>
                   8446: ENDTOGGLE
                   8447: }
                   8448: 
1.1039    www      8449: sub start_togglebox {
                   8450:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8451:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8452:     unless ($showtext) { $showtext=&mt('show'); }
                   8453:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8454:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8455:     return &start_data_table().
                   8456:            &start_data_table_header_row().
                   8457:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8458:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8459:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8460:            &end_data_table_header_row().
                   8461:            '<tr id="'.$id.'" style="display:none""><td>';
                   8462: }
                   8463: 
                   8464: sub end_togglebox {
                   8465:     return '</td></tr>'.&end_data_table();
                   8466: }
                   8467: 
1.1041    www      8468: sub LCprogressbar_script {
1.1045    www      8469:    my ($id)=@_;
1.1041    www      8470:    return(<<ENDPROGRESS);
                   8471: <script type="text/javascript">
                   8472: // <![CDATA[
1.1045    www      8473: \$('#progressbar$id').progressbar({
1.1041    www      8474:   value: 0,
                   8475:   change: function(event, ui) {
                   8476:     var newVal = \$(this).progressbar('option', 'value');
                   8477:     \$('.pblabel', this).text(LCprogressTxt);
                   8478:   }
                   8479: });
                   8480: // ]]>
                   8481: </script>
                   8482: ENDPROGRESS
                   8483: }
                   8484: 
                   8485: sub LCprogressbarUpdate_script {
                   8486:    return(<<ENDPROGRESSUPDATE);
                   8487: <style type="text/css">
                   8488: .ui-progressbar { position:relative; }
                   8489: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8490: </style>
                   8491: <script type="text/javascript">
                   8492: // <![CDATA[
1.1045    www      8493: var LCprogressTxt='---';
                   8494: 
                   8495: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      8496:    LCprogressTxt=progresstext;
1.1045    www      8497:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      8498: }
                   8499: // ]]>
                   8500: </script>
                   8501: ENDPROGRESSUPDATE
                   8502: }
                   8503: 
1.1042    www      8504: my $LClastpercent;
1.1045    www      8505: my $LCidcnt;
                   8506: my $LCcurrentid;
1.1042    www      8507: 
1.1041    www      8508: sub LCprogressbar {
1.1042    www      8509:     my ($r)=(@_);
                   8510:     $LClastpercent=0;
1.1045    www      8511:     $LCidcnt++;
                   8512:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      8513:     my $starting=&mt('Starting');
                   8514:     my $content=(<<ENDPROGBAR);
1.1045    www      8515:   <div id="progressbar$LCcurrentid">
1.1041    www      8516:     <span class="pblabel">$starting</span>
                   8517:   </div>
                   8518: ENDPROGBAR
1.1045    www      8519:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      8520: }
                   8521: 
                   8522: sub LCprogressbarUpdate {
1.1042    www      8523:     my ($r,$val,$text)=@_;
                   8524:     unless ($val) { 
                   8525:        if ($LClastpercent) {
                   8526:            $val=$LClastpercent;
                   8527:        } else {
                   8528:            $val=0;
                   8529:        }
                   8530:     }
1.1041    www      8531:     if ($val<0) { $val=0; }
                   8532:     if ($val>100) { $val=0; }
1.1042    www      8533:     $LClastpercent=$val;
1.1041    www      8534:     unless ($text) { $text=$val.'%'; }
                   8535:     $text=&js_ready($text);
1.1044    www      8536:     &r_print($r,<<ENDUPDATE);
1.1041    www      8537: <script type="text/javascript">
                   8538: // <![CDATA[
1.1045    www      8539: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      8540: // ]]>
                   8541: </script>
                   8542: ENDUPDATE
1.1035    www      8543: }
                   8544: 
1.1042    www      8545: sub LCprogressbarClose {
                   8546:     my ($r)=@_;
                   8547:     $LClastpercent=0;
1.1044    www      8548:     &r_print($r,<<ENDCLOSE);
1.1042    www      8549: <script type="text/javascript">
                   8550: // <![CDATA[
1.1045    www      8551: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8552: // ]]>
                   8553: </script>
                   8554: ENDCLOSE
1.1044    www      8555: }
                   8556: 
                   8557: sub r_print {
                   8558:     my ($r,$to_print)=@_;
                   8559:     if ($r) {
                   8560:       $r->print($to_print);
                   8561:       $r->rflush();
                   8562:     } else {
                   8563:       print($to_print);
                   8564:     }
1.1042    www      8565: }
                   8566: 
1.320     albertel 8567: sub html_encode {
                   8568:     my ($result) = @_;
                   8569: 
1.322     albertel 8570:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8571:     
                   8572:     return $result;
                   8573: }
1.1044    www      8574: 
1.317     albertel 8575: sub js_ready {
                   8576:     my ($result) = @_;
                   8577: 
1.323     albertel 8578:     $result =~ s/[\n\r]/ /xmsg;
                   8579:     $result =~ s/\\/\\\\/xmsg;
                   8580:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8581:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8582:     
                   8583:     return $result;
                   8584: }
                   8585: 
1.315     albertel 8586: sub validate_page {
                   8587:     if (  exists($env{'internal.start_page'})
1.316     albertel 8588: 	  &&     $env{'internal.start_page'} > 1) {
                   8589: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8590: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8591: 				 $ENV{'request.filename'});
1.315     albertel 8592:     }
                   8593:     if (  exists($env{'internal.end_page'})
1.316     albertel 8594: 	  &&     $env{'internal.end_page'} > 1) {
                   8595: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8596: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8597: 				 $env{'request.filename'});
1.315     albertel 8598:     }
                   8599:     if (     exists($env{'internal.start_page'})
                   8600: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8601: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8602: 				 $env{'request.filename'});
1.315     albertel 8603:     }
                   8604:     if (   ! exists($env{'internal.start_page'})
                   8605: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8606: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8607: 				 $env{'request.filename'});
1.315     albertel 8608:     }
1.306     albertel 8609: }
1.315     albertel 8610: 
1.996     www      8611: 
                   8612: sub start_scrollbox {
1.1140    raeburn  8613:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8614:     unless ($outerwidth) { $outerwidth='520px'; }
                   8615:     unless ($width) { $width='500px'; }
                   8616:     unless ($height) { $height='200px'; }
1.1075    raeburn  8617:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8618:     if ($id ne '') {
1.1140    raeburn  8619:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  8620:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8621:     }
1.1075    raeburn  8622:     if ($bgcolor ne '') {
                   8623:         $tdcol = "background-color: $bgcolor;";
                   8624:     }
1.1137    raeburn  8625:     my $nicescroll_js;
                   8626:     if ($env{'browser.mobile'}) {
1.1140    raeburn  8627:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8628:     }
                   8629:     return <<"END";
                   8630: $nicescroll_js
                   8631: 
                   8632: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   8633: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   8634: END
                   8635: }
                   8636: 
                   8637: sub end_scrollbox {
                   8638:     return '</div></td></tr></table>';
                   8639: }
                   8640: 
                   8641: sub nicescroll_javascript {
                   8642:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8643:     my %options;
                   8644:     if (ref($cursor) eq 'HASH') {
                   8645:         %options = %{$cursor};
                   8646:     }
                   8647:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8648:         $options{'railalign'} = 'left';
                   8649:     }
                   8650:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8651:         my $function  = &get_users_function();
                   8652:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  8653:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  8654:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  8655:         }
1.1140    raeburn  8656:     }
                   8657:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8658:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  8659:             $options{'cursoropacity'}='1.0';
                   8660:         }
1.1140    raeburn  8661:     } else {
                   8662:         $options{'cursoropacity'}='1.0';
                   8663:     }
                   8664:     if ($options{'cursorfixedheight'} eq 'none') {
                   8665:         delete($options{'cursorfixedheight'});
                   8666:     } else {
                   8667:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8668:     }
                   8669:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8670:         delete($options{'railoffset'});
                   8671:     }
                   8672:     my @niceoptions;
                   8673:     while (my($key,$value) = each(%options)) {
                   8674:         if ($value =~ /^\{.+\}$/) {
                   8675:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8676:         } else {
1.1140    raeburn  8677:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8678:         }
1.1140    raeburn  8679:     }
                   8680:     my $nicescroll_js = '
1.1137    raeburn  8681: $(document).ready(
1.1140    raeburn  8682:       function() {
                   8683:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8684:       }
1.1137    raeburn  8685: );
                   8686: ';
1.1140    raeburn  8687:     if ($framecheck) {
                   8688:         $nicescroll_js .= '
                   8689: function expand_div(caller) {
                   8690:     if (top === self) {
                   8691:         document.getElementById("'.$id.'").style.width = "auto";
                   8692:         document.getElementById("'.$id.'").style.height = "auto";
                   8693:     } else {
                   8694:         try {
                   8695:             if (parent.frames) {
                   8696:                 if (parent.frames.length > 1) {
                   8697:                     var framesrc = parent.frames[1].location.href;
                   8698:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8699:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8700:                         document.getElementById("'.$id.'").style.width = "auto";
                   8701:                         document.getElementById("'.$id.'").style.height = "auto";
                   8702:                     }
                   8703:                 }
                   8704:             }
                   8705:         } catch (e) {
                   8706:             return;
                   8707:         }
1.1137    raeburn  8708:     }
1.1140    raeburn  8709:     return;
1.996     www      8710: }
1.1140    raeburn  8711: ';
                   8712:     }
                   8713:     if ($needjsready) {
                   8714:         $nicescroll_js = '
                   8715: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8716:     } else {
                   8717:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8718:     }
                   8719:     return $nicescroll_js;
1.996     www      8720: }
                   8721: 
1.318     albertel 8722: sub simple_error_page {
1.1150    bisitz   8723:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  8724:     if (ref($args) eq 'HASH') {
                   8725:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8726:     } else {
                   8727:         $msg = &mt($msg);
                   8728:     }
1.1150    bisitz   8729: 
1.318     albertel 8730:     my $page =
                   8731: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   8732: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8733: 	&Apache::loncommon::end_page();
                   8734:     if (ref($r)) {
                   8735: 	$r->print($page);
1.327     albertel 8736: 	return;
1.318     albertel 8737:     }
                   8738:     return $page;
                   8739: }
1.347     albertel 8740: 
                   8741: {
1.610     albertel 8742:     my @row_count;
1.961     onken    8743: 
                   8744:     sub start_data_table_count {
                   8745:         unshift(@row_count, 0);
                   8746:         return;
                   8747:     }
                   8748: 
                   8749:     sub end_data_table_count {
                   8750:         shift(@row_count);
                   8751:         return;
                   8752:     }
                   8753: 
1.347     albertel 8754:     sub start_data_table {
1.1018    raeburn  8755: 	my ($add_class,$id) = @_;
1.422     albertel 8756: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8757:         my $table_id;
                   8758:         if (defined($id)) {
                   8759:             $table_id = ' id="'.$id.'"';
                   8760:         }
1.961     onken    8761: 	&start_data_table_count();
1.1018    raeburn  8762: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8763:     }
                   8764: 
                   8765:     sub end_data_table {
1.961     onken    8766: 	&end_data_table_count();
1.389     albertel 8767: 	return '</table>'."\n";;
1.347     albertel 8768:     }
                   8769: 
                   8770:     sub start_data_table_row {
1.974     wenzelju 8771: 	my ($add_class, $id) = @_;
1.610     albertel 8772: 	$row_count[0]++;
                   8773: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8774: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8775:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8776:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8777:     }
1.471     banghart 8778:     
                   8779:     sub continue_data_table_row {
1.974     wenzelju 8780: 	my ($add_class, $id) = @_;
1.610     albertel 8781: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8782: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8783:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8784:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8785:     }
1.347     albertel 8786: 
                   8787:     sub end_data_table_row {
1.389     albertel 8788: 	return '</tr>'."\n";;
1.347     albertel 8789:     }
1.367     www      8790: 
1.421     albertel 8791:     sub start_data_table_empty_row {
1.707     bisitz   8792: #	$row_count[0]++;
1.421     albertel 8793: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8794:     }
                   8795: 
                   8796:     sub end_data_table_empty_row {
                   8797: 	return '</tr>'."\n";;
                   8798:     }
                   8799: 
1.367     www      8800:     sub start_data_table_header_row {
1.389     albertel 8801: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8802:     }
                   8803: 
                   8804:     sub end_data_table_header_row {
1.389     albertel 8805: 	return '</tr>'."\n";;
1.367     www      8806:     }
1.890     droeschl 8807: 
                   8808:     sub data_table_caption {
                   8809:         my $caption = shift;
                   8810:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8811:     }
1.347     albertel 8812: }
                   8813: 
1.548     albertel 8814: =pod
                   8815: 
                   8816: =item * &inhibit_menu_check($arg)
                   8817: 
                   8818: Checks for a inhibitmenu state and generates output to preserve it
                   8819: 
                   8820: Inputs:         $arg - can be any of
                   8821:                      - undef - in which case the return value is a string 
                   8822:                                to add  into arguments list of a uri
                   8823:                      - 'input' - in which case the return value is a HTML
                   8824:                                  <form> <input> field of type hidden to
                   8825:                                  preserve the value
                   8826:                      - a url - in which case the return value is the url with
                   8827:                                the neccesary cgi args added to preserve the
                   8828:                                inhibitmenu state
                   8829:                      - a ref to a url - no return value, but the string is
                   8830:                                         updated to include the neccessary cgi
                   8831:                                         args to preserve the inhibitmenu state
                   8832: 
                   8833: =cut
                   8834: 
                   8835: sub inhibit_menu_check {
                   8836:     my ($arg) = @_;
                   8837:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8838:     if ($arg eq 'input') {
                   8839: 	if ($env{'form.inhibitmenu'}) {
                   8840: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8841: 	} else {
                   8842: 	    return
                   8843: 	}
                   8844:     }
                   8845:     if ($env{'form.inhibitmenu'}) {
                   8846: 	if (ref($arg)) {
                   8847: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8848: 	} elsif ($arg eq '') {
                   8849: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8850: 	} else {
                   8851: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8852: 	}
                   8853:     }
                   8854:     if (!ref($arg)) {
                   8855: 	return $arg;
                   8856:     }
                   8857: }
                   8858: 
1.251     albertel 8859: ###############################################
1.182     matthew  8860: 
                   8861: =pod
                   8862: 
1.549     albertel 8863: =back
                   8864: 
                   8865: =head1 User Information Routines
                   8866: 
                   8867: =over 4
                   8868: 
1.405     albertel 8869: =item * &get_users_function()
1.182     matthew  8870: 
                   8871: Used by &bodytag to determine the current users primary role.
                   8872: Returns either 'student','coordinator','admin', or 'author'.
                   8873: 
                   8874: =cut
                   8875: 
                   8876: ###############################################
                   8877: sub get_users_function {
1.815     tempelho 8878:     my $function = 'norole';
1.818     tempelho 8879:     if ($env{'request.role'}=~/^(st)/) {
                   8880:         $function='student';
                   8881:     }
1.907     raeburn  8882:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8883:         $function='coordinator';
                   8884:     }
1.258     albertel 8885:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8886:         $function='admin';
                   8887:     }
1.826     bisitz   8888:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8889:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8890:         $function='author';
                   8891:     }
                   8892:     return $function;
1.54      www      8893: }
1.99      www      8894: 
                   8895: ###############################################
                   8896: 
1.233     raeburn  8897: =pod
                   8898: 
1.821     raeburn  8899: =item * &show_course()
                   8900: 
                   8901: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8902: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8903: 
                   8904: Inputs:
                   8905: None
                   8906: 
                   8907: Outputs:
                   8908: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8909: 
                   8910: =cut
                   8911: 
                   8912: ###############################################
                   8913: sub show_course {
                   8914:     my $course = !$env{'user.adv'};
                   8915:     if (!$env{'user.adv'}) {
                   8916:         foreach my $env (keys(%env)) {
                   8917:             next if ($env !~ m/^user\.priv\./);
                   8918:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8919:                 $course = 0;
                   8920:                 last;
                   8921:             }
                   8922:         }
                   8923:     }
                   8924:     return $course;
                   8925: }
                   8926: 
                   8927: ###############################################
                   8928: 
                   8929: =pod
                   8930: 
1.542     raeburn  8931: =item * &check_user_status()
1.274     raeburn  8932: 
                   8933: Determines current status of supplied role for a
                   8934: specific user. Roles can be active, previous or future.
                   8935: 
                   8936: Inputs: 
                   8937: user's domain, user's username, course's domain,
1.375     raeburn  8938: course's number, optional section ID.
1.274     raeburn  8939: 
                   8940: Outputs:
                   8941: role status: active, previous or future. 
                   8942: 
                   8943: =cut
                   8944: 
                   8945: sub check_user_status {
1.412     raeburn  8946:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8947:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202    raeburn  8948:     my @uroles = keys(%userinfo);
1.274     raeburn  8949:     my $srchstr;
                   8950:     my $active_chk = 'none';
1.412     raeburn  8951:     my $now = time;
1.274     raeburn  8952:     if (@uroles > 0) {
1.908     raeburn  8953:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8954:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8955:         } else {
1.412     raeburn  8956:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8957:         }
                   8958:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8959:             my $role_end = 0;
                   8960:             my $role_start = 0;
                   8961:             $active_chk = 'active';
1.412     raeburn  8962:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8963:                 $role_end = $1;
                   8964:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8965:                     $role_start = $1;
1.274     raeburn  8966:                 }
                   8967:             }
                   8968:             if ($role_start > 0) {
1.412     raeburn  8969:                 if ($now < $role_start) {
1.274     raeburn  8970:                     $active_chk = 'future';
                   8971:                 }
                   8972:             }
                   8973:             if ($role_end > 0) {
1.412     raeburn  8974:                 if ($now > $role_end) {
1.274     raeburn  8975:                     $active_chk = 'previous';
                   8976:                 }
                   8977:             }
                   8978:         }
                   8979:     }
                   8980:     return $active_chk;
                   8981: }
                   8982: 
                   8983: ###############################################
                   8984: 
                   8985: =pod
                   8986: 
1.405     albertel 8987: =item * &get_sections()
1.233     raeburn  8988: 
                   8989: Determines all the sections for a course including
                   8990: sections with students and sections containing other roles.
1.419     raeburn  8991: Incoming parameters: 
                   8992: 
                   8993: 1. domain
                   8994: 2. course number 
                   8995: 3. reference to array containing roles for which sections should 
                   8996: be gathered (optional).
                   8997: 4. reference to array containing status types for which sections 
                   8998: should be gathered (optional).
                   8999: 
                   9000: If the third argument is undefined, sections are gathered for any role. 
                   9001: If the fourth argument is undefined, sections are gathered for any status.
                   9002: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  9003:  
1.374     raeburn  9004: Returns section hash (keys are section IDs, values are
                   9005: number of users in each section), subject to the
1.419     raeburn  9006: optional roles filter, optional status filter 
1.233     raeburn  9007: 
                   9008: =cut
                   9009: 
                   9010: ###############################################
                   9011: sub get_sections {
1.419     raeburn  9012:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 9013:     if (!defined($cdom) || !defined($cnum)) {
                   9014:         my $cid =  $env{'request.course.id'};
                   9015: 
                   9016: 	return if (!defined($cid));
                   9017: 
                   9018:         $cdom = $env{'course.'.$cid.'.domain'};
                   9019:         $cnum = $env{'course.'.$cid.'.num'};
                   9020:     }
                   9021: 
                   9022:     my %sectioncount;
1.419     raeburn  9023:     my $now = time;
1.240     albertel 9024: 
1.1118    raeburn  9025:     my $check_students = 1;
                   9026:     my $only_students = 0;
                   9027:     if (ref($possible_roles) eq 'ARRAY') {
                   9028:         if (grep(/^st$/,@{$possible_roles})) {
                   9029:             if (@{$possible_roles} == 1) {
                   9030:                 $only_students = 1;
                   9031:             }
                   9032:         } else {
                   9033:             $check_students = 0;
                   9034:         }
                   9035:     }
                   9036: 
                   9037:     if ($check_students) { 
1.276     albertel 9038: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 9039: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   9040: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  9041:         my $start_index = &Apache::loncoursedata::CL_START();
                   9042:         my $end_index = &Apache::loncoursedata::CL_END();
                   9043:         my $status;
1.366     albertel 9044: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  9045: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   9046: 				                     $data->[$status_index],
                   9047:                                                      $data->[$start_index],
                   9048:                                                      $data->[$end_index]);
                   9049:             if ($stu_status eq 'Active') {
                   9050:                 $status = 'active';
                   9051:             } elsif ($end < $now) {
                   9052:                 $status = 'previous';
                   9053:             } elsif ($start > $now) {
                   9054:                 $status = 'future';
                   9055:             } 
                   9056: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   9057:                 if ((!defined($possible_status)) || (($status ne '') && 
                   9058:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   9059: 		    $sectioncount{$section}++;
                   9060:                 }
1.240     albertel 9061: 	    }
                   9062: 	}
                   9063:     }
1.1118    raeburn  9064:     if ($only_students) {
                   9065:         return %sectioncount;
                   9066:     }
1.240     albertel 9067:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9068:     foreach my $user (sort(keys(%courseroles))) {
                   9069: 	if ($user !~ /^(\w{2})/) { next; }
                   9070: 	my ($role) = ($user =~ /^(\w{2})/);
                   9071: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  9072: 	my ($section,$status);
1.240     albertel 9073: 	if ($role eq 'cr' &&
                   9074: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   9075: 	    $section=$1;
                   9076: 	}
                   9077: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   9078: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  9079:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   9080:         if ($end == -1 && $start == -1) {
                   9081:             next; #deleted role
                   9082:         }
                   9083:         if (!defined($possible_status)) { 
                   9084:             $sectioncount{$section}++;
                   9085:         } else {
                   9086:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   9087:                 $status = 'active';
                   9088:             } elsif ($end < $now) {
                   9089:                 $status = 'future';
                   9090:             } elsif ($start > $now) {
                   9091:                 $status = 'previous';
                   9092:             }
                   9093:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   9094:                 $sectioncount{$section}++;
                   9095:             }
                   9096:         }
1.233     raeburn  9097:     }
1.366     albertel 9098:     return %sectioncount;
1.233     raeburn  9099: }
                   9100: 
1.274     raeburn  9101: ###############################################
1.294     raeburn  9102: 
                   9103: =pod
1.405     albertel 9104: 
                   9105: =item * &get_course_users()
                   9106: 
1.275     raeburn  9107: Retrieves usernames:domains for users in the specified course
                   9108: with specific role(s), and access status. 
                   9109: 
                   9110: Incoming parameters:
1.277     albertel 9111: 1. course domain
                   9112: 2. course number
                   9113: 3. access status: users must have - either active, 
1.275     raeburn  9114: previous, future, or all.
1.277     albertel 9115: 4. reference to array of permissible roles
1.288     raeburn  9116: 5. reference to array of section restrictions (optional)
                   9117: 6. reference to results object (hash of hashes).
                   9118: 7. reference to optional userdata hash
1.609     raeburn  9119: 8. reference to optional statushash
1.630     raeburn  9120: 9. flag if privileged users (except those set to unhide in
                   9121:    course settings) should be excluded    
1.609     raeburn  9122: Keys of top level results hash are roles.
1.275     raeburn  9123: Keys of inner hashes are username:domain, with 
                   9124: values set to access type.
1.288     raeburn  9125: Optional userdata hash returns an array with arguments in the 
                   9126: same order as loncoursedata::get_classlist() for student data.
                   9127: 
1.609     raeburn  9128: Optional statushash returns
                   9129: 
1.288     raeburn  9130: Entries for end, start, section and status are blank because
                   9131: of the possibility of multiple values for non-student roles.
                   9132: 
1.275     raeburn  9133: =cut
1.405     albertel 9134: 
1.275     raeburn  9135: ###############################################
1.405     albertel 9136: 
1.275     raeburn  9137: sub get_course_users {
1.630     raeburn  9138:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  9139:     my %idx = ();
1.419     raeburn  9140:     my %seclists;
1.288     raeburn  9141: 
                   9142:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   9143:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   9144:     $idx{end} = &Apache::loncoursedata::CL_END();
                   9145:     $idx{start} = &Apache::loncoursedata::CL_START();
                   9146:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   9147:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   9148:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   9149:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   9150: 
1.290     albertel 9151:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 9152:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  9153:         my $now = time;
1.277     albertel 9154:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  9155:             my $match = 0;
1.412     raeburn  9156:             my $secmatch = 0;
1.419     raeburn  9157:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  9158:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  9159:             if ($section eq '') {
                   9160:                 $section = 'none';
                   9161:             }
1.291     albertel 9162:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9163:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9164:                     $secmatch = 1;
                   9165:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 9166:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9167:                         $secmatch = 1;
                   9168:                     }
                   9169:                 } else {  
1.419     raeburn  9170: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  9171: 		        $secmatch = 1;
                   9172:                     }
1.290     albertel 9173: 		}
1.412     raeburn  9174:                 if (!$secmatch) {
                   9175:                     next;
                   9176:                 }
1.419     raeburn  9177:             }
1.275     raeburn  9178:             if (defined($$types{'active'})) {
1.288     raeburn  9179:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  9180:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  9181:                     $match = 1;
1.275     raeburn  9182:                 }
                   9183:             }
                   9184:             if (defined($$types{'previous'})) {
1.609     raeburn  9185:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  9186:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  9187:                     $match = 1;
1.275     raeburn  9188:                 }
                   9189:             }
                   9190:             if (defined($$types{'future'})) {
1.609     raeburn  9191:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  9192:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  9193:                     $match = 1;
1.275     raeburn  9194:                 }
                   9195:             }
1.609     raeburn  9196:             if ($match) {
                   9197:                 push(@{$seclists{$student}},$section);
                   9198:                 if (ref($userdata) eq 'HASH') {
                   9199:                     $$userdata{$student} = $$classlist{$student};
                   9200:                 }
                   9201:                 if (ref($statushash) eq 'HASH') {
                   9202:                     $statushash->{$student}{'st'}{$section} = $status;
                   9203:                 }
1.288     raeburn  9204:             }
1.275     raeburn  9205:         }
                   9206:     }
1.412     raeburn  9207:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  9208:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9209:         my $now = time;
1.609     raeburn  9210:         my %displaystatus = ( previous => 'Expired',
                   9211:                               active   => 'Active',
                   9212:                               future   => 'Future',
                   9213:                             );
1.1121    raeburn  9214:         my (%nothide,@possdoms);
1.630     raeburn  9215:         if ($hidepriv) {
                   9216:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   9217:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   9218:                 if ($user !~ /:/) {
                   9219:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   9220:                 } else {
                   9221:                     $nothide{$user} = 1;
                   9222:                 }
                   9223:             }
1.1121    raeburn  9224:             my @possdoms = ($cdom);
                   9225:             if ($coursehash{'checkforpriv'}) {
                   9226:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   9227:             }
1.630     raeburn  9228:         }
1.439     raeburn  9229:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  9230:             my $match = 0;
1.412     raeburn  9231:             my $secmatch = 0;
1.439     raeburn  9232:             my $status;
1.412     raeburn  9233:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  9234:             $user =~ s/:$//;
1.439     raeburn  9235:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   9236:             if ($end == -1 || $start == -1) {
                   9237:                 next;
                   9238:             }
                   9239:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   9240:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  9241:                 my ($uname,$udom) = split(/:/,$user);
                   9242:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9243:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9244:                         $secmatch = 1;
                   9245:                     } elsif ($usec eq '') {
1.420     albertel 9246:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9247:                             $secmatch = 1;
                   9248:                         }
                   9249:                     } else {
                   9250:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   9251:                             $secmatch = 1;
                   9252:                         }
                   9253:                     }
                   9254:                     if (!$secmatch) {
                   9255:                         next;
                   9256:                     }
1.288     raeburn  9257:                 }
1.419     raeburn  9258:                 if ($usec eq '') {
                   9259:                     $usec = 'none';
                   9260:                 }
1.275     raeburn  9261:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  9262:                     if ($hidepriv) {
1.1121    raeburn  9263:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  9264:                             (!$nothide{$uname.':'.$udom})) {
                   9265:                             next;
                   9266:                         }
                   9267:                     }
1.503     raeburn  9268:                     if ($end > 0 && $end < $now) {
1.439     raeburn  9269:                         $status = 'previous';
                   9270:                     } elsif ($start > $now) {
                   9271:                         $status = 'future';
                   9272:                     } else {
                   9273:                         $status = 'active';
                   9274:                     }
1.277     albertel 9275:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  9276:                         if ($status eq $type) {
1.420     albertel 9277:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  9278:                                 push(@{$$users{$role}{$user}},$type);
                   9279:                             }
1.288     raeburn  9280:                             $match = 1;
                   9281:                         }
                   9282:                     }
1.419     raeburn  9283:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   9284:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   9285: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   9286:                         }
1.420     albertel 9287:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  9288:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   9289:                         }
1.609     raeburn  9290:                         if (ref($statushash) eq 'HASH') {
                   9291:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   9292:                         }
1.275     raeburn  9293:                     }
                   9294:                 }
                   9295:             }
                   9296:         }
1.290     albertel 9297:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  9298:             if ((defined($cdom)) && (defined($cnum))) {
                   9299:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   9300:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   9301:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  9302:                     next if ($owner eq '');
                   9303:                     my ($ownername,$ownerdom);
                   9304:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   9305:                         $ownername = $1;
                   9306:                         $ownerdom = $2;
                   9307:                     } else {
                   9308:                         $ownername = $owner;
                   9309:                         $ownerdom = $cdom;
                   9310:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  9311:                     }
                   9312:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 9313:                     if (defined($userdata) && 
1.609     raeburn  9314: 			!exists($$userdata{$owner})) {
                   9315: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   9316:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   9317:                             push(@{$seclists{$owner}},'none');
                   9318:                         }
                   9319:                         if (ref($statushash) eq 'HASH') {
                   9320:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  9321:                         }
1.290     albertel 9322: 		    }
1.279     raeburn  9323:                 }
                   9324:             }
                   9325:         }
1.419     raeburn  9326:         foreach my $user (keys(%seclists)) {
                   9327:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   9328:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   9329:         }
1.275     raeburn  9330:     }
                   9331:     return;
                   9332: }
                   9333: 
1.288     raeburn  9334: sub get_user_info {
                   9335:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 9336:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   9337: 	&plainname($uname,$udom,'lastname');
1.291     albertel 9338:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  9339:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  9340:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   9341:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  9342:     return;
                   9343: }
1.275     raeburn  9344: 
1.472     raeburn  9345: ###############################################
                   9346: 
                   9347: =pod
                   9348: 
                   9349: =item * &get_user_quota()
                   9350: 
1.1134    raeburn  9351: Retrieves quota assigned for storage of user files.
                   9352: Default is to report quota for portfolio files.
1.472     raeburn  9353: 
                   9354: Incoming parameters:
                   9355: 1. user's username
                   9356: 2. user's domain
1.1134    raeburn  9357: 3. quota name - portfolio, author, or course
1.1136    raeburn  9358:    (if no quota name provided, defaults to portfolio).
1.1237    raeburn  9359: 4. crstype - official, unofficial, textbook, placement or community, 
                   9360:    if quota name is course
1.472     raeburn  9361: 
                   9362: Returns:
1.1163    raeburn  9363: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  9364: 2. (Optional) Type of setting: custom or default
                   9365:    (individually assigned or default for user's 
                   9366:    institutional status).
                   9367: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   9368:    or student - types as defined in localenroll::inst_usertypes 
                   9369:    for user's domain, which determines default quota for user.
                   9370: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  9371: 
                   9372: If a value has been stored in the user's environment, 
1.536     raeburn  9373: it will return that, otherwise it returns the maximal default
1.1134    raeburn  9374: defined for the user's institutional status(es) in the domain.
1.472     raeburn  9375: 
                   9376: =cut
                   9377: 
                   9378: ###############################################
                   9379: 
                   9380: 
                   9381: sub get_user_quota {
1.1136    raeburn  9382:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  9383:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  9384:     if (!defined($udom)) {
                   9385:         $udom = $env{'user.domain'};
                   9386:     }
                   9387:     if (!defined($uname)) {
                   9388:         $uname = $env{'user.name'};
                   9389:     }
                   9390:     if (($udom eq '' || $uname eq '') ||
                   9391:         ($udom eq 'public') && ($uname eq 'public')) {
                   9392:         $quota = 0;
1.536     raeburn  9393:         $quotatype = 'default';
                   9394:         $defquota = 0; 
1.472     raeburn  9395:     } else {
1.536     raeburn  9396:         my $inststatus;
1.1134    raeburn  9397:         if ($quotaname eq 'course') {
                   9398:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   9399:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   9400:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   9401:             } else {
                   9402:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   9403:                 $quota = $cenv{'internal.uploadquota'};
                   9404:             }
1.536     raeburn  9405:         } else {
1.1134    raeburn  9406:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   9407:                 if ($quotaname eq 'author') {
                   9408:                     $quota = $env{'environment.authorquota'};
                   9409:                 } else {
                   9410:                     $quota = $env{'environment.portfolioquota'};
                   9411:                 }
                   9412:                 $inststatus = $env{'environment.inststatus'};
                   9413:             } else {
                   9414:                 my %userenv = 
                   9415:                     &Apache::lonnet::get('environment',['portfolioquota',
                   9416:                                          'authorquota','inststatus'],$udom,$uname);
                   9417:                 my ($tmp) = keys(%userenv);
                   9418:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9419:                     if ($quotaname eq 'author') {
                   9420:                         $quota = $userenv{'authorquota'};
                   9421:                     } else {
                   9422:                         $quota = $userenv{'portfolioquota'};
                   9423:                     }
                   9424:                     $inststatus = $userenv{'inststatus'};
                   9425:                 } else {
                   9426:                     undef(%userenv);
                   9427:                 }
                   9428:             }
                   9429:         }
                   9430:         if ($quota eq '' || wantarray) {
                   9431:             if ($quotaname eq 'course') {
                   9432:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  9433:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
1.1237    raeburn  9434:                     ($crstype eq 'community') || ($crstype eq 'textbook') ||
                   9435:                     ($crstype eq 'placement')) { 
1.1136    raeburn  9436:                     $defquota = $domdefs{$crstype.'quota'};
                   9437:                 }
                   9438:                 if ($defquota eq '') {
                   9439:                     $defquota = 500;
                   9440:                 }
1.1134    raeburn  9441:             } else {
                   9442:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   9443:             }
                   9444:             if ($quota eq '') {
                   9445:                 $quota = $defquota;
                   9446:                 $quotatype = 'default';
                   9447:             } else {
                   9448:                 $quotatype = 'custom';
                   9449:             }
1.472     raeburn  9450:         }
                   9451:     }
1.536     raeburn  9452:     if (wantarray) {
                   9453:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9454:     } else {
                   9455:         return $quota;
                   9456:     }
1.472     raeburn  9457: }
                   9458: 
                   9459: ###############################################
                   9460: 
                   9461: =pod
                   9462: 
                   9463: =item * &default_quota()
                   9464: 
1.536     raeburn  9465: Retrieves default quota assigned for storage of user portfolio files,
                   9466: given an (optional) user's institutional status.
1.472     raeburn  9467: 
                   9468: Incoming parameters:
1.1142    raeburn  9469: 
1.472     raeburn  9470: 1. domain
1.536     raeburn  9471: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9472:    status types (e.g., faculty, staff, student etc.)
                   9473:    which apply to the user for whom the default is being retrieved.
                   9474:    If the institutional status string in undefined, the domain
1.1134    raeburn  9475:    default quota will be returned.
                   9476: 3.  quota name - portfolio, author, or course
                   9477:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9478: 
                   9479: Returns:
1.1142    raeburn  9480: 
1.1163    raeburn  9481: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9482: 2. (Optional) institutional type which determined the value of the
                   9483:    default quota.
1.472     raeburn  9484: 
                   9485: If a value has been stored in the domain's configuration db,
                   9486: it will return that, otherwise it returns 20 (for backwards 
                   9487: compatibility with domains which have not set up a configuration
1.1163    raeburn  9488: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9489: 
1.536     raeburn  9490: If the user's status includes multiple types (e.g., staff and student),
                   9491: the largest default quota which applies to the user determines the
                   9492: default quota returned.
                   9493: 
1.472     raeburn  9494: =cut
                   9495: 
                   9496: ###############################################
                   9497: 
                   9498: 
                   9499: sub default_quota {
1.1134    raeburn  9500:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9501:     my ($defquota,$settingstatus);
                   9502:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9503:                                             ['quotas'],$udom);
1.1134    raeburn  9504:     my $key = 'defaultquota';
                   9505:     if ($quotaname eq 'author') {
                   9506:         $key = 'authorquota';
                   9507:     }
1.622     raeburn  9508:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9509:         if ($inststatus ne '') {
1.765     raeburn  9510:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9511:             foreach my $item (@statuses) {
1.1134    raeburn  9512:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9513:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9514:                         if ($defquota eq '') {
1.1134    raeburn  9515:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9516:                             $settingstatus = $item;
1.1134    raeburn  9517:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9518:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9519:                             $settingstatus = $item;
                   9520:                         }
                   9521:                     }
1.1134    raeburn  9522:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9523:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9524:                         if ($defquota eq '') {
                   9525:                             $defquota = $quotahash{'quotas'}{$item};
                   9526:                             $settingstatus = $item;
                   9527:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9528:                             $defquota = $quotahash{'quotas'}{$item};
                   9529:                             $settingstatus = $item;
                   9530:                         }
1.536     raeburn  9531:                     }
                   9532:                 }
                   9533:             }
                   9534:         }
                   9535:         if ($defquota eq '') {
1.1134    raeburn  9536:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9537:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9538:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9539:                 $defquota = $quotahash{'quotas'}{'default'};
                   9540:             }
1.536     raeburn  9541:             $settingstatus = 'default';
1.1139    raeburn  9542:             if ($defquota eq '') {
                   9543:                 if ($quotaname eq 'author') {
                   9544:                     $defquota = 500;
                   9545:                 }
                   9546:             }
1.536     raeburn  9547:         }
                   9548:     } else {
                   9549:         $settingstatus = 'default';
1.1134    raeburn  9550:         if ($quotaname eq 'author') {
                   9551:             $defquota = 500;
                   9552:         } else {
                   9553:             $defquota = 20;
                   9554:         }
1.536     raeburn  9555:     }
                   9556:     if (wantarray) {
                   9557:         return ($defquota,$settingstatus);
1.472     raeburn  9558:     } else {
1.536     raeburn  9559:         return $defquota;
1.472     raeburn  9560:     }
                   9561: }
                   9562: 
1.1135    raeburn  9563: ###############################################
                   9564: 
                   9565: =pod
                   9566: 
1.1136    raeburn  9567: =item * &excess_filesize_warning()
1.1135    raeburn  9568: 
                   9569: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  9570: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  9571: space to be exceeded.
1.1136    raeburn  9572: 
                   9573: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  9574: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  9575: 
1.1165    raeburn  9576: Inputs: 7 
1.1136    raeburn  9577: 1. username or coursenum
1.1135    raeburn  9578: 2. domain
1.1136    raeburn  9579: 3. context ('author' or 'course')
1.1135    raeburn  9580: 4. filename of file for which action is being requested
                   9581: 5. filesize (kB) of file
                   9582: 6. action being taken: copy or upload.
1.1237    raeburn  9583: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135    raeburn  9584: 
                   9585: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  9586:          otherwise return null.
                   9587: 
                   9588: =back
1.1135    raeburn  9589: 
                   9590: =cut
                   9591: 
1.1136    raeburn  9592: sub excess_filesize_warning {
1.1165    raeburn  9593:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  9594:     my $current_disk_usage = 0;
1.1165    raeburn  9595:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  9596:     if ($context eq 'author') {
                   9597:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9598:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9599:     } else {
                   9600:         foreach my $subdir ('docs','supplemental') {
                   9601:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9602:         }
                   9603:     }
1.1135    raeburn  9604:     $disk_quota = int($disk_quota * 1000);
                   9605:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   9606:         return '<p class="LC_warning">'.
1.1135    raeburn  9607:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   9608:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9609:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  9610:                             $disk_quota,$current_disk_usage).
                   9611:                '</p>';
                   9612:     }
                   9613:     return;
                   9614: }
                   9615: 
                   9616: ###############################################
                   9617: 
                   9618: 
1.1136    raeburn  9619: 
                   9620: 
1.384     raeburn  9621: sub get_secgrprole_info {
                   9622:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9623:     my %sections_count = &get_sections($cdom,$cnum);
                   9624:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9625:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9626:     my @groups = sort(keys(%curr_groups));
                   9627:     my $allroles = [];
                   9628:     my $rolehash;
                   9629:     my $accesshash = {
                   9630:                      active => 'Currently has access',
                   9631:                      future => 'Will have future access',
                   9632:                      previous => 'Previously had access',
                   9633:                   };
                   9634:     if ($needroles) {
                   9635:         $rolehash = {'all' => 'all'};
1.385     albertel 9636:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9637: 	if (&Apache::lonnet::error(%user_roles)) {
                   9638: 	    undef(%user_roles);
                   9639: 	}
                   9640:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9641:             my ($role)=split(/\:/,$item,2);
                   9642:             if ($role eq 'cr') { next; }
                   9643:             if ($role =~ /^cr/) {
                   9644:                 $$rolehash{$role} = (split('/',$role))[3];
                   9645:             } else {
                   9646:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9647:             }
                   9648:         }
                   9649:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9650:             push(@{$allroles},$key);
                   9651:         }
                   9652:         push (@{$allroles},'st');
                   9653:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9654:     }
                   9655:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9656: }
                   9657: 
1.555     raeburn  9658: sub user_picker {
1.994     raeburn  9659:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9660:     my $currdom = $dom;
                   9661:     my %curr_selected = (
                   9662:                         srchin => 'dom',
1.580     raeburn  9663:                         srchby => 'lastname',
1.555     raeburn  9664:                       );
                   9665:     my $srchterm;
1.625     raeburn  9666:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9667:         if ($srch->{'srchby'} ne '') {
                   9668:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9669:         }
                   9670:         if ($srch->{'srchin'} ne '') {
                   9671:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9672:         }
                   9673:         if ($srch->{'srchtype'} ne '') {
                   9674:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9675:         }
                   9676:         if ($srch->{'srchdomain'} ne '') {
                   9677:             $currdom = $srch->{'srchdomain'};
                   9678:         }
                   9679:         $srchterm = $srch->{'srchterm'};
                   9680:     }
1.1222    damieng  9681:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  9682:                     'usr'       => 'Search criteria',
1.563     raeburn  9683:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9684:                     'uname'     => 'username',
                   9685:                     'lastname'  => 'last name',
1.555     raeburn  9686:                     'lastfirst' => 'last name, first name',
1.558     albertel 9687:                     'crs'       => 'in this course',
1.576     raeburn  9688:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9689:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9690:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9691:                     'exact'     => 'is',
                   9692:                     'contains'  => 'contains',
1.569     raeburn  9693:                     'begins'    => 'begins with',
1.1222    damieng  9694:                                        );
                   9695:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  9696:                     'youm'      => "You must include some text to search for.",
                   9697:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9698:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9699:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9700:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9701:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9702:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9703:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9704:                                        );
1.1222    damieng  9705:     &html_escape(\%html_lt);
                   9706:     &js_escape(\%js_lt);
1.563     raeburn  9707:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9708:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9709: 
                   9710:     my @srchins = ('crs','dom','alc','instd');
                   9711: 
                   9712:     foreach my $option (@srchins) {
                   9713:         # FIXME 'alc' option unavailable until 
                   9714:         #       loncreateuser::print_user_query_page()
                   9715:         #       has been completed.
                   9716:         next if ($option eq 'alc');
1.880     raeburn  9717:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9718:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9719:         if ($curr_selected{'srchin'} eq $option) {
                   9720:             $srchinsel .= ' 
1.1222    damieng  9721:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  9722:         } else {
                   9723:             $srchinsel .= '
1.1222    damieng  9724:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  9725:         }
1.555     raeburn  9726:     }
1.563     raeburn  9727:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9728: 
                   9729:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9730:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9731:         if ($curr_selected{'srchby'} eq $option) {
                   9732:             $srchbysel .= '
1.1222    damieng  9733:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9734:         } else {
                   9735:             $srchbysel .= '
1.1222    damieng  9736:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9737:          }
                   9738:     }
                   9739:     $srchbysel .= "\n  </select>\n";
                   9740: 
                   9741:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9742:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9743:         if ($curr_selected{'srchtype'} eq $option) {
                   9744:             $srchtypesel .= '
1.1222    damieng  9745:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9746:         } else {
                   9747:             $srchtypesel .= '
1.1222    damieng  9748:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9749:         }
                   9750:     }
                   9751:     $srchtypesel .= "\n  </select>\n";
                   9752: 
1.558     albertel 9753:     my ($newuserscript,$new_user_create);
1.994     raeburn  9754:     my $context_dom = $env{'request.role.domain'};
                   9755:     if ($context eq 'requestcrs') {
                   9756:         if ($env{'form.coursedom'} ne '') { 
                   9757:             $context_dom = $env{'form.coursedom'};
                   9758:         }
                   9759:     }
1.556     raeburn  9760:     if ($forcenewuser) {
1.576     raeburn  9761:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9762:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9763:                 if ($cancreate) {
                   9764:                     $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>';
                   9765:                 } else {
1.799     bisitz   9766:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9767:                     my %usertypetext = (
                   9768:                         official   => 'institutional',
                   9769:                         unofficial => 'non-institutional',
                   9770:                     );
1.799     bisitz   9771:                     $new_user_create = '<p class="LC_warning">'
                   9772:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9773:                                       .' '
                   9774:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9775:                                           ,'<a href="'.$helplink.'">','</a>')
                   9776:                                       .'</p><br />';
1.627     raeburn  9777:                 }
1.576     raeburn  9778:             }
                   9779:         }
                   9780: 
1.556     raeburn  9781:         $newuserscript = <<"ENDSCRIPT";
                   9782: 
1.570     raeburn  9783: function setSearch(createnew,callingForm) {
1.556     raeburn  9784:     if (createnew == 1) {
1.570     raeburn  9785:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9786:             if (callingForm.srchby.options[i].value == 'uname') {
                   9787:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9788:             }
                   9789:         }
1.570     raeburn  9790:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9791:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9792: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9793:             }
                   9794:         }
1.570     raeburn  9795:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9796:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9797:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9798:             }
                   9799:         }
1.570     raeburn  9800:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9801:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9802:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9803:             }
                   9804:         }
                   9805:     }
                   9806: }
                   9807: ENDSCRIPT
1.558     albertel 9808: 
1.556     raeburn  9809:     }
                   9810: 
1.555     raeburn  9811:     my $output = <<"END_BLOCK";
1.556     raeburn  9812: <script type="text/javascript">
1.824     bisitz   9813: // <![CDATA[
1.570     raeburn  9814: function validateEntry(callingForm) {
1.558     albertel 9815: 
1.556     raeburn  9816:     var checkok = 1;
1.558     albertel 9817:     var srchin;
1.570     raeburn  9818:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9819: 	if ( callingForm.srchin[i].checked ) {
                   9820: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9821: 	}
                   9822:     }
                   9823: 
1.570     raeburn  9824:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9825:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9826:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9827:     var srchterm =  callingForm.srchterm.value;
                   9828:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9829:     var msg = "";
                   9830: 
                   9831:     if (srchterm == "") {
                   9832:         checkok = 0;
1.1222    damieng  9833:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  9834:     }
                   9835: 
1.569     raeburn  9836:     if (srchtype== 'begins') {
                   9837:         if (srchterm.length < 2) {
                   9838:             checkok = 0;
1.1222    damieng  9839:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  9840:         }
                   9841:     }
                   9842: 
1.556     raeburn  9843:     if (srchtype== 'contains') {
                   9844:         if (srchterm.length < 3) {
                   9845:             checkok = 0;
1.1222    damieng  9846:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  9847:         }
                   9848:     }
                   9849:     if (srchin == 'instd') {
                   9850:         if (srchdomain == '') {
                   9851:             checkok = 0;
1.1222    damieng  9852:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  9853:         }
                   9854:     }
                   9855:     if (srchin == 'dom') {
                   9856:         if (srchdomain == '') {
                   9857:             checkok = 0;
1.1222    damieng  9858:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  9859:         }
                   9860:     }
                   9861:     if (srchby == 'lastfirst') {
                   9862:         if (srchterm.indexOf(",") == -1) {
                   9863:             checkok = 0;
1.1222    damieng  9864:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  9865:         }
                   9866:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9867:             checkok = 0;
1.1222    damieng  9868:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  9869:         }
                   9870:     }
                   9871:     if (checkok == 0) {
1.1222    damieng  9872:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  9873:         return;
                   9874:     }
                   9875:     if (checkok == 1) {
1.570     raeburn  9876:         callingForm.submit();
1.556     raeburn  9877:     }
                   9878: }
                   9879: 
                   9880: $newuserscript
                   9881: 
1.824     bisitz   9882: // ]]>
1.556     raeburn  9883: </script>
1.558     albertel 9884: 
                   9885: $new_user_create
                   9886: 
1.555     raeburn  9887: END_BLOCK
1.558     albertel 9888: 
1.876     raeburn  9889:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222    damieng  9890:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  9891:                $domform.
                   9892:                &Apache::lonhtmlcommon::row_closure().
1.1222    damieng  9893:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  9894:                $srchbysel.
                   9895:                $srchtypesel. 
                   9896:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9897:                $srchinsel.
                   9898:                &Apache::lonhtmlcommon::row_closure(1). 
                   9899:                &Apache::lonhtmlcommon::end_pick_box().
                   9900:                '<br />';
1.555     raeburn  9901:     return $output;
                   9902: }
                   9903: 
1.612     raeburn  9904: sub user_rule_check {
1.615     raeburn  9905:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226    raeburn  9906:     my ($response,%inst_response);
1.612     raeburn  9907:     if (ref($usershash) eq 'HASH') {
1.1226    raeburn  9908:         if (keys(%{$usershash}) > 1) {
                   9909:             my (%by_username,%by_id,%userdoms);
                   9910:             my $checkid; 
                   9911:             if (ref($checks) eq 'HASH') {
                   9912:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   9913:                     $checkid = 1;
                   9914:                 }
                   9915:             }
                   9916:             foreach my $user (keys(%{$usershash})) {
                   9917:                 my ($uname,$udom) = split(/:/,$user);
                   9918:                 if ($checkid) {
                   9919:                     if (ref($usershash->{$user}) eq 'HASH') {
                   9920:                         if ($usershash->{$user}->{'id'} ne '') {
1.1227    raeburn  9921:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
1.1226    raeburn  9922:                             $userdoms{$udom} = 1;
1.1227    raeburn  9923:                             if (ref($inst_results) eq 'HASH') {
                   9924:                                 $inst_results->{$uname.':'.$udom} = {};
                   9925:                             }
1.1226    raeburn  9926:                         }
                   9927:                     }
                   9928:                 } else {
                   9929:                     $by_username{$udom}{$uname} = 1;
                   9930:                     $userdoms{$udom} = 1;
1.1227    raeburn  9931:                     if (ref($inst_results) eq 'HASH') {
                   9932:                         $inst_results->{$uname.':'.$udom} = {};
                   9933:                     }
1.1226    raeburn  9934:                 }
                   9935:             }
                   9936:             foreach my $udom (keys(%userdoms)) {
                   9937:                 if (!$got_rules->{$udom}) {
                   9938:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9939:                                                              ['usercreation'],$udom);
                   9940:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   9941:                         foreach my $item ('username','id') {
                   9942:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227    raeburn  9943:                                 $$curr_rules{$udom}{$item} =
                   9944:                                     $domconfig{'usercreation'}{$item.'_rule'};
1.1226    raeburn  9945:                             }
                   9946:                         }
                   9947:                     }
                   9948:                     $got_rules->{$udom} = 1;
                   9949:                 }
1.612     raeburn  9950:             }
1.1226    raeburn  9951:             if ($checkid) {
                   9952:                 foreach my $udom (keys(%by_id)) {
                   9953:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   9954:                     if ($outcome eq 'ok') {
1.1227    raeburn  9955:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   9956:                             my $uname = $by_id{$udom}{$id};
                   9957:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9958:                         }
1.1226    raeburn  9959:                         if (ref($results) eq 'HASH') {
                   9960:                             foreach my $uname (keys(%{$results})) {
1.1227    raeburn  9961:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   9962:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   9963:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9964:                                 }
1.1226    raeburn  9965:                             }
                   9966:                         }
                   9967:                     }
1.612     raeburn  9968:                 }
1.615     raeburn  9969:             } else {
1.1226    raeburn  9970:                 foreach my $udom (keys(%by_username)) {
                   9971:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   9972:                     if ($outcome eq 'ok') {
1.1227    raeburn  9973:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   9974:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9975:                         }
1.1226    raeburn  9976:                         if (ref($results) eq 'HASH') {
                   9977:                             foreach my $uname (keys(%{$results})) {
                   9978:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9979:                             }
                   9980:                         }
                   9981:                     }
                   9982:                 }
1.612     raeburn  9983:             }
1.1226    raeburn  9984:         } elsif (keys(%{$usershash}) == 1) {
                   9985:             my $user = (keys(%{$usershash}))[0];
                   9986:             my ($uname,$udom) = split(/:/,$user);
                   9987:             if (($udom ne '') && ($uname ne '')) {
                   9988:                 if (ref($usershash->{$user}) eq 'HASH') {
                   9989:                     if (ref($checks) eq 'HASH') {
                   9990:                         if (defined($checks->{'username'})) {
                   9991:                             ($inst_response{$user},%{$inst_results->{$user}}) = 
                   9992:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   9993:                         } elsif (defined($checks->{'id'})) {
                   9994:                             if ($usershash->{$user}->{'id'} ne '') {
                   9995:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   9996:                                     &Apache::lonnet::get_instuser($udom,undef,
                   9997:                                                                   $usershash->{$user}->{'id'});
                   9998:                             } else {
                   9999:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10000:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   10001:                             }
1.585     raeburn  10002:                         }
1.1226    raeburn  10003:                     } else {
                   10004:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   10005:                             &Apache::lonnet::get_instuser($udom,$uname);
                   10006:                        return;
                   10007:                     }
                   10008:                     if (!$got_rules->{$udom}) {
                   10009:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10010:                                                                  ['usercreation'],$udom);
                   10011:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10012:                             foreach my $item ('username','id') {
                   10013:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10014:                                    $$curr_rules{$udom}{$item} = 
                   10015:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   10016:                                 }
                   10017:                             }
                   10018:                         }
                   10019:                         $got_rules->{$udom} = 1;
1.585     raeburn  10020:                     }
                   10021:                 }
1.1226    raeburn  10022:             } else {
                   10023:                 return;
                   10024:             }
                   10025:         } else {
                   10026:             return;
                   10027:         }
                   10028:         foreach my $user (keys(%{$usershash})) {
                   10029:             my ($uname,$udom) = split(/:/,$user);
                   10030:             next if (($udom eq '') || ($uname eq ''));
                   10031:             my $id;
1.1227    raeburn  10032:             if (ref($inst_results) eq 'HASH') {
                   10033:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   10034:                     $id = $inst_results->{$user}->{'id'};
                   10035:                 }
                   10036:             }
                   10037:             if ($id eq '') { 
                   10038:                 if (ref($usershash->{$user})) {
                   10039:                     $id = $usershash->{$user}->{'id'};
                   10040:                 }
1.585     raeburn  10041:             }
1.612     raeburn  10042:             foreach my $item (keys(%{$checks})) {
                   10043:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   10044:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   10045:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226    raeburn  10046:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   10047:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  10048:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   10049:                                 if ($rule_check{$rule}) {
                   10050:                                     $$rulematch{$user}{$item} = $rule;
1.1226    raeburn  10051:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  10052:                                         if (ref($inst_results) eq 'HASH') {
                   10053:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   10054:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   10055:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1227    raeburn  10056:                                                 } elsif ($item eq 'id') {
                   10057:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   10058:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   10059:                                                     }
1.615     raeburn  10060:                                                 }
1.612     raeburn  10061:                                             }
                   10062:                                         }
1.615     raeburn  10063:                                     }
                   10064:                                     last;
1.585     raeburn  10065:                                 }
                   10066:                             }
                   10067:                         }
                   10068:                     }
                   10069:                 }
                   10070:             }
                   10071:         }
                   10072:     }
1.612     raeburn  10073:     return;
                   10074: }
                   10075: 
                   10076: sub user_rule_formats {
                   10077:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   10078:     my %text = ( 
                   10079:                  'username' => 'Usernames',
                   10080:                  'id'       => 'IDs',
                   10081:                );
                   10082:     my $output;
                   10083:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   10084:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   10085:         if (@{$ruleorder} > 0) {
1.1102    raeburn  10086:             $output = '<br />'.
                   10087:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   10088:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   10089:                       ' <ul>';
1.612     raeburn  10090:             foreach my $rule (@{$ruleorder}) {
                   10091:                 if (ref($curr_rules) eq 'ARRAY') {
                   10092:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   10093:                         if (ref($rules->{$rule}) eq 'HASH') {
                   10094:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   10095:                                         $rules->{$rule}{'desc'}.'</li>';
                   10096:                         }
                   10097:                     }
                   10098:                 }
                   10099:             }
                   10100:             $output .= '</ul>';
                   10101:         }
                   10102:     }
                   10103:     return $output;
                   10104: }
                   10105: 
                   10106: sub instrule_disallow_msg {
1.615     raeburn  10107:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  10108:     my $response;
                   10109:     my %text = (
                   10110:                   item   => 'username',
                   10111:                   items  => 'usernames',
                   10112:                   match  => 'matches',
                   10113:                   do     => 'does',
                   10114:                   action => 'a username',
                   10115:                   one    => 'one',
                   10116:                );
                   10117:     if ($count > 1) {
                   10118:         $text{'item'} = 'usernames';
                   10119:         $text{'match'} ='match';
                   10120:         $text{'do'} = 'do';
                   10121:         $text{'action'} = 'usernames',
                   10122:         $text{'one'} = 'ones';
                   10123:     }
                   10124:     if ($checkitem eq 'id') {
                   10125:         $text{'items'} = 'IDs';
                   10126:         $text{'item'} = 'ID';
                   10127:         $text{'action'} = 'an ID';
1.615     raeburn  10128:         if ($count > 1) {
                   10129:             $text{'item'} = 'IDs';
                   10130:             $text{'action'} = 'IDs';
                   10131:         }
1.612     raeburn  10132:     }
1.674     bisitz   10133:     $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  10134:     if ($mode eq 'upload') {
                   10135:         if ($checkitem eq 'username') {
                   10136:             $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'}.");
                   10137:         } elsif ($checkitem eq 'id') {
1.674     bisitz   10138:             $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  10139:         }
1.669     raeburn  10140:     } elsif ($mode eq 'selfcreate') {
                   10141:         if ($checkitem eq 'id') {
                   10142:             $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.");
                   10143:         }
1.615     raeburn  10144:     } else {
                   10145:         if ($checkitem eq 'username') {
                   10146:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   10147:         } elsif ($checkitem eq 'id') {
                   10148:             $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.");
                   10149:         }
1.612     raeburn  10150:     }
                   10151:     return $response;
1.585     raeburn  10152: }
                   10153: 
1.624     raeburn  10154: sub personal_data_fieldtitles {
                   10155:     my %fieldtitles = &Apache::lonlocal::texthash (
                   10156:                         id => 'Student/Employee ID',
                   10157:                         permanentemail => 'E-mail address',
                   10158:                         lastname => 'Last Name',
                   10159:                         firstname => 'First Name',
                   10160:                         middlename => 'Middle Name',
                   10161:                         generation => 'Generation',
                   10162:                         gen => 'Generation',
1.765     raeburn  10163:                         inststatus => 'Affiliation',
1.624     raeburn  10164:                    );
                   10165:     return %fieldtitles;
                   10166: }
                   10167: 
1.642     raeburn  10168: sub sorted_inst_types {
                   10169:     my ($dom) = @_;
1.1185    raeburn  10170:     my ($usertypes,$order);
                   10171:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   10172:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   10173:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   10174:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   10175:     } else {
                   10176:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   10177:     }
1.642     raeburn  10178:     my $othertitle = &mt('All users');
                   10179:     if ($env{'request.course.id'}) {
1.668     raeburn  10180:         $othertitle  = &mt('Any users');
1.642     raeburn  10181:     }
                   10182:     my @types;
                   10183:     if (ref($order) eq 'ARRAY') {
                   10184:         @types = @{$order};
                   10185:     }
                   10186:     if (@types == 0) {
                   10187:         if (ref($usertypes) eq 'HASH') {
                   10188:             @types = sort(keys(%{$usertypes}));
                   10189:         }
                   10190:     }
                   10191:     if (keys(%{$usertypes}) > 0) {
                   10192:         $othertitle = &mt('Other users');
                   10193:     }
                   10194:     return ($othertitle,$usertypes,\@types);
                   10195: }
                   10196: 
1.645     raeburn  10197: sub get_institutional_codes {
                   10198:     my ($settings,$allcourses,$LC_code) = @_;
                   10199: # Get complete list of course sections to update
                   10200:     my @currsections = ();
                   10201:     my @currxlists = ();
                   10202:     my $coursecode = $$settings{'internal.coursecode'};
                   10203: 
                   10204:     if ($$settings{'internal.sectionnums'} ne '') {
                   10205:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   10206:     }
                   10207: 
                   10208:     if ($$settings{'internal.crosslistings'} ne '') {
                   10209:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   10210:     }
                   10211: 
                   10212:     if (@currxlists > 0) {
                   10213:         foreach (@currxlists) {
                   10214:             if (m/^([^:]+):(\w*)$/) {
                   10215:                 unless (grep/^$1$/,@{$allcourses}) {
                   10216:                     push @{$allcourses},$1;
                   10217:                     $$LC_code{$1} = $2;
                   10218:                 }
                   10219:             }
                   10220:         }
                   10221:     }
                   10222:  
                   10223:     if (@currsections > 0) {
                   10224:         foreach (@currsections) {
                   10225:             if (m/^(\w+):(\w*)$/) {
                   10226:                 my $sec = $coursecode.$1;
                   10227:                 my $lc_sec = $2;
                   10228:                 unless (grep/^$sec$/,@{$allcourses}) {
                   10229:                     push @{$allcourses},$sec;
                   10230:                     $$LC_code{$sec} = $lc_sec;
                   10231:                 }
                   10232:             }
                   10233:         }
                   10234:     }
                   10235:     return;
                   10236: }
                   10237: 
1.971     raeburn  10238: sub get_standard_codeitems {
                   10239:     return ('Year','Semester','Department','Number','Section');
                   10240: }
                   10241: 
1.112     bowersj2 10242: =pod
                   10243: 
1.780     raeburn  10244: =head1 Slot Helpers
                   10245: 
                   10246: =over 4
                   10247: 
                   10248: =item * sorted_slots()
                   10249: 
1.1040    raeburn  10250: Sorts an array of slot names in order of an optional sort key,
                   10251: default sort is by slot start time (earliest first). 
1.780     raeburn  10252: 
                   10253: Inputs:
                   10254: 
                   10255: =over 4
                   10256: 
                   10257: slotsarr  - Reference to array of unsorted slot names.
                   10258: 
                   10259: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   10260: 
1.1040    raeburn  10261: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   10262: 
1.549     albertel 10263: =back
                   10264: 
1.780     raeburn  10265: Returns:
                   10266: 
                   10267: =over 4
                   10268: 
1.1040    raeburn  10269: sorted   - An array of slot names sorted by a specified sort key 
                   10270:            (default sort key is start time of the slot).
1.780     raeburn  10271: 
                   10272: =back
                   10273: 
                   10274: =cut
                   10275: 
                   10276: 
                   10277: sub sorted_slots {
1.1040    raeburn  10278:     my ($slotsarr,$slots,$sortkey) = @_;
                   10279:     if ($sortkey eq '') {
                   10280:         $sortkey = 'starttime';
                   10281:     }
1.780     raeburn  10282:     my @sorted;
                   10283:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   10284:         @sorted =
                   10285:             sort {
                   10286:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  10287:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  10288:                      }
                   10289:                      if (ref($slots->{$a})) { return -1;}
                   10290:                      if (ref($slots->{$b})) { return 1;}
                   10291:                      return 0;
                   10292:                  } @{$slotsarr};
                   10293:     }
                   10294:     return @sorted;
                   10295: }
                   10296: 
1.1040    raeburn  10297: =pod
                   10298: 
                   10299: =item * get_future_slots()
                   10300: 
                   10301: Inputs:
                   10302: 
                   10303: =over 4
                   10304: 
                   10305: cnum - course number
                   10306: 
                   10307: cdom - course domain
                   10308: 
                   10309: now - current UNIX time
                   10310: 
                   10311: symb - optional symb
                   10312: 
                   10313: =back
                   10314: 
                   10315: Returns:
                   10316: 
                   10317: =over 4
                   10318: 
                   10319: sorted_reservable - ref to array of student_schedulable slots currently 
                   10320:                     reservable, ordered by end date of reservation period.
                   10321: 
                   10322: reservable_now - ref to hash of student_schedulable slots currently
                   10323:                  reservable.
                   10324: 
                   10325:     Keys in inner hash are:
                   10326:     (a) symb: either blank or symb to which slot use is restricted.
                   10327:     (b) endreserve: end date of reservation period. 
                   10328: 
                   10329: sorted_future - ref to array of student_schedulable slots reservable in
                   10330:                 the future, ordered by start date of reservation period.
                   10331: 
                   10332: future_reservable - ref to hash of student_schedulable slots reservable
                   10333:                     in the future.
                   10334: 
                   10335:     Keys in inner hash are:
                   10336:     (a) symb: either blank or symb to which slot use is restricted.
                   10337:     (b) startreserve:  start date of reservation period.
                   10338: 
                   10339: =back
                   10340: 
                   10341: =cut
                   10342: 
                   10343: sub get_future_slots {
                   10344:     my ($cnum,$cdom,$now,$symb) = @_;
1.1229    raeburn  10345:     my $map;
                   10346:     if ($symb) {
                   10347:         ($map) = &Apache::lonnet::decode_symb($symb);
                   10348:     }
1.1040    raeburn  10349:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   10350:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   10351:     foreach my $slot (keys(%slots)) {
                   10352:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   10353:         if ($symb) {
1.1229    raeburn  10354:             if ($slots{$slot}->{'symb'} ne '') {
                   10355:                 my $canuse;
                   10356:                 my %oksymbs;
                   10357:                 my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   10358:                 map { $oksymbs{$_} = 1; } @slotsymbs;
                   10359:                 if ($oksymbs{$symb}) {
                   10360:                     $canuse = 1;
                   10361:                 } else {
                   10362:                     foreach my $item (@slotsymbs) {
                   10363:                         if ($item =~ /\.(page|sequence)$/) {
                   10364:                             (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                   10365:                             if (($map ne '') && ($map eq $sloturl)) {
                   10366:                                 $canuse = 1;
                   10367:                                 last;
                   10368:                             }
                   10369:                         }
                   10370:                     }
                   10371:                 }
                   10372:                 next unless ($canuse);
                   10373:             }
1.1040    raeburn  10374:         }
                   10375:         if (($slots{$slot}->{'starttime'} > $now) &&
                   10376:             ($slots{$slot}->{'endtime'} > $now)) {
                   10377:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   10378:                 my $userallowed = 0;
                   10379:                 if ($slots{$slot}->{'allowedsections'}) {
                   10380:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   10381:                     if (!defined($env{'request.role.sec'})
                   10382:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   10383:                         $userallowed=1;
                   10384:                     } else {
                   10385:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   10386:                             $userallowed=1;
                   10387:                         }
                   10388:                     }
                   10389:                     unless ($userallowed) {
                   10390:                         if (defined($env{'request.course.groups'})) {
                   10391:                             my @groups = split(/:/,$env{'request.course.groups'});
                   10392:                             foreach my $group (@groups) {
                   10393:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   10394:                                     $userallowed=1;
                   10395:                                     last;
                   10396:                                 }
                   10397:                             }
                   10398:                         }
                   10399:                     }
                   10400:                 }
                   10401:                 if ($slots{$slot}->{'allowedusers'}) {
                   10402:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   10403:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   10404:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   10405:                         $userallowed = 1;
                   10406:                     }
                   10407:                 }
                   10408:                 next unless($userallowed);
                   10409:             }
                   10410:             my $startreserve = $slots{$slot}->{'startreserve'};
                   10411:             my $endreserve = $slots{$slot}->{'endreserve'};
                   10412:             my $symb = $slots{$slot}->{'symb'};
                   10413:             if (($startreserve < $now) &&
                   10414:                 (!$endreserve || $endreserve > $now)) {
                   10415:                 my $lastres = $endreserve;
                   10416:                 if (!$lastres) {
                   10417:                     $lastres = $slots{$slot}->{'starttime'};
                   10418:                 }
                   10419:                 $reservable_now{$slot} = {
                   10420:                                            symb       => $symb,
                   10421:                                            endreserve => $lastres
                   10422:                                          };
                   10423:             } elsif (($startreserve > $now) &&
                   10424:                      (!$endreserve || $endreserve > $startreserve)) {
                   10425:                 $future_reservable{$slot} = {
                   10426:                                               symb         => $symb,
                   10427:                                               startreserve => $startreserve
                   10428:                                             };
                   10429:             }
                   10430:         }
                   10431:     }
                   10432:     my @unsorted_reservable = keys(%reservable_now);
                   10433:     if (@unsorted_reservable > 0) {
                   10434:         @sorted_reservable = 
                   10435:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   10436:     }
                   10437:     my @unsorted_future = keys(%future_reservable);
                   10438:     if (@unsorted_future > 0) {
                   10439:         @sorted_future =
                   10440:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   10441:     }
                   10442:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   10443: }
1.780     raeburn  10444: 
                   10445: =pod
                   10446: 
1.1057    foxr     10447: =back
                   10448: 
1.549     albertel 10449: =head1 HTTP Helpers
                   10450: 
                   10451: =over 4
                   10452: 
1.648     raeburn  10453: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 10454: 
1.258     albertel 10455: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 10456: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 10457: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 10458: 
                   10459: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   10460: $possible_names is an ref to an array of form element names.  As an example:
                   10461: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 10462: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 10463: 
                   10464: =cut
1.1       albertel 10465: 
1.6       albertel 10466: sub get_unprocessed_cgi {
1.25      albertel 10467:   my ($query,$possible_names)= @_;
1.26      matthew  10468:   # $Apache::lonxml::debug=1;
1.356     albertel 10469:   foreach my $pair (split(/&/,$query)) {
                   10470:     my ($name, $value) = split(/=/,$pair);
1.369     www      10471:     $name = &unescape($name);
1.25      albertel 10472:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   10473:       $value =~ tr/+/ /;
                   10474:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10475:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10476:     }
1.16      harris41 10477:   }
1.6       albertel 10478: }
                   10479: 
1.112     bowersj2 10480: =pod
                   10481: 
1.648     raeburn  10482: =item * &cacheheader() 
1.112     bowersj2 10483: 
                   10484: returns cache-controlling header code
                   10485: 
                   10486: =cut
                   10487: 
1.7       albertel 10488: sub cacheheader {
1.258     albertel 10489:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10490:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10491:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10492:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10493:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10494:     return $output;
1.7       albertel 10495: }
                   10496: 
1.112     bowersj2 10497: =pod
                   10498: 
1.648     raeburn  10499: =item * &no_cache($r) 
1.112     bowersj2 10500: 
                   10501: specifies header code to not have cache
                   10502: 
                   10503: =cut
                   10504: 
1.9       albertel 10505: sub no_cache {
1.216     albertel 10506:     my ($r) = @_;
                   10507:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10508: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10509:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10510:     $r->no_cache(1);
                   10511:     $r->header_out("Expires" => $date);
                   10512:     $r->header_out("Pragma" => "no-cache");
1.123     www      10513: }
                   10514: 
                   10515: sub content_type {
1.181     albertel 10516:     my ($r,$type,$charset) = @_;
1.299     foxr     10517:     if ($r) {
                   10518: 	#  Note that printout.pl calls this with undef for $r.
                   10519: 	&no_cache($r);
                   10520:     }
1.258     albertel 10521:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10522:     unless ($charset) {
                   10523: 	$charset=&Apache::lonlocal::current_encoding;
                   10524:     }
                   10525:     if ($charset) { $type.='; charset='.$charset; }
                   10526:     if ($r) {
                   10527: 	$r->content_type($type);
                   10528:     } else {
                   10529: 	print("Content-type: $type\n\n");
                   10530:     }
1.9       albertel 10531: }
1.25      albertel 10532: 
1.112     bowersj2 10533: =pod
                   10534: 
1.648     raeburn  10535: =item * &add_to_env($name,$value) 
1.112     bowersj2 10536: 
1.258     albertel 10537: adds $name to the %env hash with value
1.112     bowersj2 10538: $value, if $name already exists, the entry is converted to an array
                   10539: reference and $value is added to the array.
                   10540: 
                   10541: =cut
                   10542: 
1.25      albertel 10543: sub add_to_env {
                   10544:   my ($name,$value)=@_;
1.258     albertel 10545:   if (defined($env{$name})) {
                   10546:     if (ref($env{$name})) {
1.25      albertel 10547:       #already have multiple values
1.258     albertel 10548:       push(@{ $env{$name} },$value);
1.25      albertel 10549:     } else {
                   10550:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 10551:       my $first=$env{$name};
                   10552:       undef($env{$name});
                   10553:       push(@{ $env{$name} },$first,$value);
1.25      albertel 10554:     }
                   10555:   } else {
1.258     albertel 10556:     $env{$name}=$value;
1.25      albertel 10557:   }
1.31      albertel 10558: }
1.149     albertel 10559: 
                   10560: =pod
                   10561: 
1.648     raeburn  10562: =item * &get_env_multiple($name) 
1.149     albertel 10563: 
1.258     albertel 10564: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 10565: values may be defined and end up as an array ref.
                   10566: 
                   10567: returns an array of values
                   10568: 
                   10569: =cut
                   10570: 
                   10571: sub get_env_multiple {
                   10572:     my ($name) = @_;
                   10573:     my @values;
1.258     albertel 10574:     if (defined($env{$name})) {
1.149     albertel 10575:         # exists is it an array
1.258     albertel 10576:         if (ref($env{$name})) {
                   10577:             @values=@{ $env{$name} };
1.149     albertel 10578:         } else {
1.258     albertel 10579:             $values[0]=$env{$name};
1.149     albertel 10580:         }
                   10581:     }
                   10582:     return(@values);
                   10583: }
                   10584: 
1.660     raeburn  10585: sub ask_for_embedded_content {
                   10586:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  10587:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  10588:         %currsubfile,%unused,$rem);
1.1071    raeburn  10589:     my $counter = 0;
                   10590:     my $numnew = 0;
1.987     raeburn  10591:     my $numremref = 0;
                   10592:     my $numinvalid = 0;
                   10593:     my $numpathchg = 0;
                   10594:     my $numexisting = 0;
1.1071    raeburn  10595:     my $numunused = 0;
                   10596:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  10597:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  10598:     my $heading = &mt('Upload embedded files');
                   10599:     my $buttontext = &mt('Upload');
                   10600: 
1.1085    raeburn  10601:     if ($env{'request.course.id'}) {
1.1123    raeburn  10602:         if ($actionurl eq '/adm/dependencies') {
                   10603:             $navmap = Apache::lonnavmaps::navmap->new();
                   10604:         }
                   10605:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   10606:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  10607:     }
1.1123    raeburn  10608:     if (($actionurl eq '/adm/portfolio') || 
                   10609:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  10610:         my $current_path='/';
                   10611:         if ($env{'form.currentpath'}) {
                   10612:             $current_path = $env{'form.currentpath'};
                   10613:         }
                   10614:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  10615:             $udom = $cdom;
                   10616:             $uname = $cnum;
1.984     raeburn  10617:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   10618:         } else {
                   10619:             $udom = $env{'user.domain'};
                   10620:             $uname = $env{'user.name'};
                   10621:             $url = '/userfiles/portfolio';
                   10622:         }
1.987     raeburn  10623:         $toplevel = $url.'/';
1.984     raeburn  10624:         $url .= $current_path;
                   10625:         $getpropath = 1;
1.987     raeburn  10626:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   10627:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      10628:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  10629:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  10630:         $toplevel = $url;
1.984     raeburn  10631:         if ($rest ne '') {
1.987     raeburn  10632:             $url .= $rest;
                   10633:         }
                   10634:     } elsif ($actionurl eq '/adm/coursedocs') {
                   10635:         if (ref($args) eq 'HASH') {
1.1071    raeburn  10636:             $url = $args->{'docs_url'};
                   10637:             $toplevel = $url;
1.1084    raeburn  10638:             if ($args->{'context'} eq 'paste') {
                   10639:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   10640:                 ($path) = 
                   10641:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10642:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10643:                 $fileloc =~ s{^/}{};
                   10644:             }
1.1071    raeburn  10645:         }
1.1084    raeburn  10646:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  10647:         if ($env{'request.course.id'} ne '') {
                   10648:             if (ref($args) eq 'HASH') {
                   10649:                 $url = $args->{'docs_url'};
                   10650:                 $title = $args->{'docs_title'};
1.1126    raeburn  10651:                 $toplevel = $url; 
                   10652:                 unless ($toplevel =~ m{^/}) {
                   10653:                     $toplevel = "/$url";
                   10654:                 }
1.1085    raeburn  10655:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  10656:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   10657:                     $path = $1;
                   10658:                 } else {
                   10659:                     ($path) =
                   10660:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10661:                 }
1.1195    raeburn  10662:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   10663:                     $fileloc = $toplevel;
                   10664:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   10665:                     my ($udom,$uname,$fname) =
                   10666:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   10667:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   10668:                 } else {
                   10669:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10670:                 }
1.1071    raeburn  10671:                 $fileloc =~ s{^/}{};
                   10672:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   10673:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   10674:             }
1.987     raeburn  10675:         }
1.1123    raeburn  10676:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10677:         $udom = $cdom;
                   10678:         $uname = $cnum;
                   10679:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   10680:         $toplevel = $url;
                   10681:         $path = $url;
                   10682:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   10683:         $fileloc =~ s{^/}{};
1.987     raeburn  10684:     }
1.1126    raeburn  10685:     foreach my $file (keys(%{$allfiles})) {
                   10686:         my $embed_file;
                   10687:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   10688:             $embed_file = $1;
                   10689:         } else {
                   10690:             $embed_file = $file;
                   10691:         }
1.1158    raeburn  10692:         my ($absolutepath,$cleaned_file);
                   10693:         if ($embed_file =~ m{^\w+://}) {
                   10694:             $cleaned_file = $embed_file;
1.1147    raeburn  10695:             $newfiles{$cleaned_file} = 1;
                   10696:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10697:         } else {
1.1158    raeburn  10698:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  10699:             if ($embed_file =~ m{^/}) {
                   10700:                 $absolutepath = $embed_file;
                   10701:             }
1.1147    raeburn  10702:             if ($cleaned_file =~ m{/}) {
                   10703:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  10704:                 $path = &check_for_traversal($path,$url,$toplevel);
                   10705:                 my $item = $fname;
                   10706:                 if ($path ne '') {
                   10707:                     $item = $path.'/'.$fname;
                   10708:                     $subdependencies{$path}{$fname} = 1;
                   10709:                 } else {
                   10710:                     $dependencies{$item} = 1;
                   10711:                 }
                   10712:                 if ($absolutepath) {
                   10713:                     $mapping{$item} = $absolutepath;
                   10714:                 } else {
                   10715:                     $mapping{$item} = $embed_file;
                   10716:                 }
                   10717:             } else {
                   10718:                 $dependencies{$embed_file} = 1;
                   10719:                 if ($absolutepath) {
1.1147    raeburn  10720:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  10721:                 } else {
1.1147    raeburn  10722:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10723:                 }
                   10724:             }
1.984     raeburn  10725:         }
                   10726:     }
1.1071    raeburn  10727:     my $dirptr = 16384;
1.984     raeburn  10728:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  10729:         $currsubfile{$path} = {};
1.1123    raeburn  10730:         if (($actionurl eq '/adm/portfolio') || 
                   10731:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10732:             my ($sublistref,$listerror) =
                   10733:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   10734:             if (ref($sublistref) eq 'ARRAY') {
                   10735:                 foreach my $line (@{$sublistref}) {
                   10736:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  10737:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  10738:                 }
1.984     raeburn  10739:             }
1.987     raeburn  10740:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10741:             if (opendir(my $dir,$url.'/'.$path)) {
                   10742:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  10743:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   10744:             }
1.1084    raeburn  10745:         } elsif (($actionurl eq '/adm/dependencies') ||
                   10746:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10747:                   ($args->{'context'} eq 'paste')) ||
                   10748:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10749:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  10750:                 my $dir;
                   10751:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10752:                     $dir = $fileloc;
                   10753:                 } else {
                   10754:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10755:                 }
1.1071    raeburn  10756:                 if ($dir ne '') {
                   10757:                     my ($sublistref,$listerror) =
                   10758:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10759:                     if (ref($sublistref) eq 'ARRAY') {
                   10760:                         foreach my $line (@{$sublistref}) {
                   10761:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10762:                                 undef,$mtime)=split(/\&/,$line,12);
                   10763:                             unless (($testdir&$dirptr) ||
                   10764:                                     ($file_name =~ /^\.\.?$/)) {
                   10765:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10766:                             }
                   10767:                         }
                   10768:                     }
                   10769:                 }
1.984     raeburn  10770:             }
                   10771:         }
                   10772:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10773:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10774:                 my $item = $path.'/'.$file;
                   10775:                 unless ($mapping{$item} eq $item) {
                   10776:                     $pathchanges{$item} = 1;
                   10777:                 }
                   10778:                 $existing{$item} = 1;
                   10779:                 $numexisting ++;
                   10780:             } else {
                   10781:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10782:             }
                   10783:         }
1.1071    raeburn  10784:         if ($actionurl eq '/adm/dependencies') {
                   10785:             foreach my $path (keys(%currsubfile)) {
                   10786:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10787:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10788:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  10789:                              next if (($rem ne '') &&
                   10790:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10791:                                        (ref($navmap) &&
                   10792:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10793:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10794:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10795:                              $unused{$path.'/'.$file} = 1; 
                   10796:                          }
                   10797:                     }
                   10798:                 }
                   10799:             }
                   10800:         }
1.984     raeburn  10801:     }
1.987     raeburn  10802:     my %currfile;
1.1123    raeburn  10803:     if (($actionurl eq '/adm/portfolio') ||
                   10804:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10805:         my ($dirlistref,$listerror) =
                   10806:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10807:         if (ref($dirlistref) eq 'ARRAY') {
                   10808:             foreach my $line (@{$dirlistref}) {
                   10809:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10810:                 $currfile{$file_name} = 1;
                   10811:             }
1.984     raeburn  10812:         }
1.987     raeburn  10813:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10814:         if (opendir(my $dir,$url)) {
1.987     raeburn  10815:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10816:             map {$currfile{$_} = 1;} @dir_list;
                   10817:         }
1.1084    raeburn  10818:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10819:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10820:               ($args->{'context'} eq 'paste')) ||
                   10821:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10822:         if ($env{'request.course.id'} ne '') {
                   10823:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10824:             if ($dir ne '') {
                   10825:                 my ($dirlistref,$listerror) =
                   10826:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10827:                 if (ref($dirlistref) eq 'ARRAY') {
                   10828:                     foreach my $line (@{$dirlistref}) {
                   10829:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10830:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10831:                         unless (($testdir&$dirptr) ||
                   10832:                                 ($file_name =~ /^\.\.?$/)) {
                   10833:                             $currfile{$file_name} = [$size,$mtime];
                   10834:                         }
                   10835:                     }
                   10836:                 }
                   10837:             }
                   10838:         }
1.984     raeburn  10839:     }
                   10840:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10841:         if (exists($currfile{$file})) {
1.987     raeburn  10842:             unless ($mapping{$file} eq $file) {
                   10843:                 $pathchanges{$file} = 1;
                   10844:             }
                   10845:             $existing{$file} = 1;
                   10846:             $numexisting ++;
                   10847:         } else {
1.984     raeburn  10848:             $newfiles{$file} = 1;
                   10849:         }
                   10850:     }
1.1071    raeburn  10851:     foreach my $file (keys(%currfile)) {
                   10852:         unless (($file eq $filename) ||
                   10853:                 ($file eq $filename.'.bak') ||
                   10854:                 ($dependencies{$file})) {
1.1085    raeburn  10855:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10856:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10857:                     next if (($rem ne '') &&
                   10858:                              (($env{"httpref.$rem".$file} ne '') ||
                   10859:                               (ref($navmap) &&
                   10860:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10861:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10862:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10863:                 }
1.1085    raeburn  10864:             }
1.1071    raeburn  10865:             $unused{$file} = 1;
                   10866:         }
                   10867:     }
1.1084    raeburn  10868:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10869:         ($args->{'context'} eq 'paste')) {
                   10870:         $counter = scalar(keys(%existing));
                   10871:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10872:         return ($output,$counter,$numpathchg,\%existing);
                   10873:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10874:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10875:         $counter = scalar(keys(%existing));
                   10876:         $numpathchg = scalar(keys(%pathchanges));
                   10877:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10878:     }
1.984     raeburn  10879:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10880:         if ($actionurl eq '/adm/dependencies') {
                   10881:             next if ($embed_file =~ m{^\w+://});
                   10882:         }
1.660     raeburn  10883:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10884:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10885:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10886:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10887:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10888:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10889:         }
1.1123    raeburn  10890:         $upload_output .= '</td>';
1.1071    raeburn  10891:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10892:             $upload_output.='<td align="right">'.
                   10893:                             '<span class="LC_info LC_fontsize_medium">'.
                   10894:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10895:             $numremref++;
1.660     raeburn  10896:         } elsif ($args->{'error_on_invalid_names'}
                   10897:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10898:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10899:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10900:             $numinvalid++;
1.660     raeburn  10901:         } else {
1.1123    raeburn  10902:             $upload_output .= '<td>'.
                   10903:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10904:                                                      $embed_file,\%mapping,
1.1071    raeburn  10905:                                                      $allfiles,$codebase,'upload');
                   10906:             $counter ++;
                   10907:             $numnew ++;
1.987     raeburn  10908:         }
                   10909:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10910:     }
                   10911:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10912:         if ($actionurl eq '/adm/dependencies') {
                   10913:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10914:             $modify_output .= &start_data_table_row().
                   10915:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10916:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10917:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10918:                               '<td>'.$size.'</td>'.
                   10919:                               '<td>'.$mtime.'</td>'.
                   10920:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10921:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10922:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10923:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10924:                               &embedded_file_element('upload_embedded',$counter,
                   10925:                                                      $embed_file,\%mapping,
                   10926:                                                      $allfiles,$codebase,'modify').
                   10927:                               '</div></td>'.
                   10928:                               &end_data_table_row()."\n";
                   10929:             $counter ++;
                   10930:         } else {
                   10931:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10932:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10933:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10934:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10935:                               &Apache::loncommon::end_data_table_row()."\n";
                   10936:         }
                   10937:     }
                   10938:     my $delidx = $counter;
                   10939:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10940:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10941:         $delete_output .= &start_data_table_row().
                   10942:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10943:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10944:                           '<td>'.$size.'</td>'.
                   10945:                           '<td>'.$mtime.'</td>'.
                   10946:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10947:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10948:                           &embedded_file_element('upload_embedded',$delidx,
                   10949:                                                  $oldfile,\%mapping,$allfiles,
                   10950:                                                  $codebase,'delete').'</td>'.
                   10951:                           &end_data_table_row()."\n"; 
                   10952:         $numunused ++;
                   10953:         $delidx ++;
1.987     raeburn  10954:     }
                   10955:     if ($upload_output) {
                   10956:         $upload_output = &start_data_table().
                   10957:                          $upload_output.
                   10958:                          &end_data_table()."\n";
                   10959:     }
1.1071    raeburn  10960:     if ($modify_output) {
                   10961:         $modify_output = &start_data_table().
                   10962:                          &start_data_table_header_row().
                   10963:                          '<th>'.&mt('File').'</th>'.
                   10964:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10965:                          '<th>'.&mt('Modified').'</th>'.
                   10966:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10967:                          &end_data_table_header_row().
                   10968:                          $modify_output.
                   10969:                          &end_data_table()."\n";
                   10970:     }
                   10971:     if ($delete_output) {
                   10972:         $delete_output = &start_data_table().
                   10973:                          &start_data_table_header_row().
                   10974:                          '<th>'.&mt('File').'</th>'.
                   10975:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10976:                          '<th>'.&mt('Modified').'</th>'.
                   10977:                          '<th>'.&mt('Delete?').'</th>'.
                   10978:                          &end_data_table_header_row().
                   10979:                          $delete_output.
                   10980:                          &end_data_table()."\n";
                   10981:     }
1.987     raeburn  10982:     my $applies = 0;
                   10983:     if ($numremref) {
                   10984:         $applies ++;
                   10985:     }
                   10986:     if ($numinvalid) {
                   10987:         $applies ++;
                   10988:     }
                   10989:     if ($numexisting) {
                   10990:         $applies ++;
                   10991:     }
1.1071    raeburn  10992:     if ($counter || $numunused) {
1.987     raeburn  10993:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10994:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10995:                   $state.'<h3>'.$heading.'</h3>'; 
                   10996:         if ($actionurl eq '/adm/dependencies') {
                   10997:             if ($numnew) {
                   10998:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10999:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   11000:                            $upload_output.'<br />'."\n";
                   11001:             }
                   11002:             if ($numexisting) {
                   11003:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   11004:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   11005:                            $modify_output.'<br />'."\n";
                   11006:                            $buttontext = &mt('Save changes');
                   11007:             }
                   11008:             if ($numunused) {
                   11009:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   11010:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   11011:                            $delete_output.'<br />'."\n";
                   11012:                            $buttontext = &mt('Save changes');
                   11013:             }
                   11014:         } else {
                   11015:             $output .= $upload_output.'<br />'."\n";
                   11016:         }
                   11017:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   11018:                    $counter.'" />'."\n";
                   11019:         if ($actionurl eq '/adm/dependencies') { 
                   11020:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   11021:                        $numnew.'" />'."\n";
                   11022:         } elsif ($actionurl eq '') {
1.987     raeburn  11023:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   11024:         }
                   11025:     } elsif ($applies) {
                   11026:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   11027:         if ($applies > 1) {
                   11028:             $output .=  
1.1123    raeburn  11029:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  11030:             if ($numremref) {
                   11031:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   11032:             }
                   11033:             if ($numinvalid) {
                   11034:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   11035:             }
                   11036:             if ($numexisting) {
                   11037:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   11038:             }
                   11039:             $output .= '</ul><br />';
                   11040:         } elsif ($numremref) {
                   11041:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   11042:         } elsif ($numinvalid) {
                   11043:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   11044:         } elsif ($numexisting) {
                   11045:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   11046:         }
                   11047:         $output .= $upload_output.'<br />';
                   11048:     }
                   11049:     my ($pathchange_output,$chgcount);
1.1071    raeburn  11050:     $chgcount = $counter;
1.987     raeburn  11051:     if (keys(%pathchanges) > 0) {
                   11052:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  11053:             if ($counter) {
1.987     raeburn  11054:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   11055:                                                   $embed_file,\%mapping,
1.1071    raeburn  11056:                                                   $allfiles,$codebase,'change');
1.987     raeburn  11057:             } else {
                   11058:                 $pathchange_output .= 
                   11059:                     &start_data_table_row().
                   11060:                     '<td><input type ="checkbox" name="namechange" value="'.
                   11061:                     $chgcount.'" checked="checked" /></td>'.
                   11062:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   11063:                     '<td>'.$embed_file.
                   11064:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  11065:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  11066:                     '</td>'.&end_data_table_row();
1.660     raeburn  11067:             }
1.987     raeburn  11068:             $numpathchg ++;
                   11069:             $chgcount ++;
1.660     raeburn  11070:         }
                   11071:     }
1.1127    raeburn  11072:     if (($counter) || ($numunused)) {
1.987     raeburn  11073:         if ($numpathchg) {
                   11074:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   11075:                        $numpathchg.'" />'."\n";
                   11076:         }
                   11077:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   11078:             ($actionurl eq '/adm/imsimport')) {
                   11079:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   11080:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   11081:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  11082:         } elsif ($actionurl eq '/adm/dependencies') {
                   11083:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  11084:         }
1.1123    raeburn  11085:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  11086:     } elsif ($numpathchg) {
                   11087:         my %pathchange = ();
                   11088:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   11089:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11090:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  11091:         }
1.987     raeburn  11092:     }
1.1071    raeburn  11093:     return ($output,$counter,$numpathchg);
1.987     raeburn  11094: }
                   11095: 
1.1147    raeburn  11096: =pod
                   11097: 
                   11098: =item * clean_path($name)
                   11099: 
                   11100: Performs clean-up of directories, subdirectories and filename in an
                   11101: embedded object, referenced in an HTML file which is being uploaded
                   11102: to a course or portfolio, where 
                   11103: "Upload embedded images/multimedia files if HTML file" checkbox was
                   11104: checked.
                   11105: 
                   11106: Clean-up is similar to replacements in lonnet::clean_filename()
                   11107: except each / between sub-directory and next level is preserved.
                   11108: 
                   11109: =cut
                   11110: 
                   11111: sub clean_path {
                   11112:     my ($embed_file) = @_;
                   11113:     $embed_file =~s{^/+}{};
                   11114:     my @contents;
                   11115:     if ($embed_file =~ m{/}) {
                   11116:         @contents = split(/\//,$embed_file);
                   11117:     } else {
                   11118:         @contents = ($embed_file);
                   11119:     }
                   11120:     my $lastidx = scalar(@contents)-1;
                   11121:     for (my $i=0; $i<=$lastidx; $i++) { 
                   11122:         $contents[$i]=~s{\\}{/}g;
                   11123:         $contents[$i]=~s/\s+/\_/g;
                   11124:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   11125:         if ($i == $lastidx) {
                   11126:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   11127:         }
                   11128:     }
                   11129:     if ($lastidx > 0) {
                   11130:         return join('/',@contents);
                   11131:     } else {
                   11132:         return $contents[0];
                   11133:     }
                   11134: }
                   11135: 
1.987     raeburn  11136: sub embedded_file_element {
1.1071    raeburn  11137:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  11138:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   11139:                    (ref($codebase) eq 'HASH'));
                   11140:     my $output;
1.1071    raeburn  11141:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  11142:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   11143:     }
                   11144:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   11145:                &escape($embed_file).'" />';
                   11146:     unless (($context eq 'upload_embedded') && 
                   11147:             ($mapping->{$embed_file} eq $embed_file)) {
                   11148:         $output .='
                   11149:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   11150:     }
                   11151:     my $attrib;
                   11152:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   11153:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   11154:     }
                   11155:     $output .=
                   11156:         "\n\t\t".
                   11157:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   11158:         $attrib.'" />';
                   11159:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   11160:         $output .=
                   11161:             "\n\t\t".
                   11162:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   11163:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  11164:     }
1.987     raeburn  11165:     return $output;
1.660     raeburn  11166: }
                   11167: 
1.1071    raeburn  11168: sub get_dependency_details {
                   11169:     my ($currfile,$currsubfile,$embed_file) = @_;
                   11170:     my ($size,$mtime,$showsize,$showmtime);
                   11171:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   11172:         if ($embed_file =~ m{/}) {
                   11173:             my ($path,$fname) = split(/\//,$embed_file);
                   11174:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   11175:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   11176:             }
                   11177:         } else {
                   11178:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   11179:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   11180:             }
                   11181:         }
                   11182:         $showsize = $size/1024.0;
                   11183:         $showsize = sprintf("%.1f",$showsize);
                   11184:         if ($mtime > 0) {
                   11185:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   11186:         }
                   11187:     }
                   11188:     return ($showsize,$showmtime);
                   11189: }
                   11190: 
                   11191: sub ask_embedded_js {
                   11192:     return <<"END";
                   11193: <script type="text/javascript"">
                   11194: // <![CDATA[
                   11195: function toggleBrowse(counter) {
                   11196:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   11197:     var fileid = document.getElementById('embedded_item_'+counter);
                   11198:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   11199:     if (chkboxid.checked == true) {
                   11200:         uploaddivid.style.display='block';
                   11201:     } else {
                   11202:         uploaddivid.style.display='none';
                   11203:         fileid.value = '';
                   11204:     }
                   11205: }
                   11206: // ]]>
                   11207: </script>
                   11208: 
                   11209: END
                   11210: }
                   11211: 
1.661     raeburn  11212: sub upload_embedded {
                   11213:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  11214:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   11215:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  11216:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   11217:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   11218:         my $orig_uploaded_filename =
                   11219:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  11220:         foreach my $type ('orig','ref','attrib','codebase') {
                   11221:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   11222:                 $env{'form.embedded_'.$type.'_'.$i} =
                   11223:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   11224:             }
                   11225:         }
1.661     raeburn  11226:         my ($path,$fname) =
                   11227:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   11228:         # no path, whole string is fname
                   11229:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   11230:         $fname = &Apache::lonnet::clean_filename($fname);
                   11231:         # See if there is anything left
                   11232:         next if ($fname eq '');
                   11233: 
                   11234:         # Check if file already exists as a file or directory.
                   11235:         my ($state,$msg);
                   11236:         if ($context eq 'portfolio') {
                   11237:             my $port_path = $dirpath;
                   11238:             if ($group ne '') {
                   11239:                 $port_path = "groups/$group/$port_path";
                   11240:             }
1.987     raeburn  11241:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   11242:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  11243:                                               $dir_root,$port_path,$disk_quota,
                   11244:                                               $current_disk_usage,$uname,$udom);
                   11245:             if ($state eq 'will_exceed_quota'
1.984     raeburn  11246:                 || $state eq 'file_locked') {
1.661     raeburn  11247:                 $output .= $msg;
                   11248:                 next;
                   11249:             }
                   11250:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   11251:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   11252:             if ($state eq 'exists') {
                   11253:                 $output .= $msg;
                   11254:                 next;
                   11255:             }
                   11256:         }
                   11257:         # Check if extension is valid
                   11258:         if (($fname =~ /\.(\w+)$/) &&
                   11259:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   11260:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   11261:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  11262:             next;
                   11263:         } elsif (($fname =~ /\.(\w+)$/) &&
                   11264:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  11265:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  11266:             next;
                   11267:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   11268:             $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  11269:             next;
                   11270:         }
                   11271:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  11272:         my $subdir = $path;
                   11273:         $subdir =~ s{/+$}{};
1.661     raeburn  11274:         if ($context eq 'portfolio') {
1.984     raeburn  11275:             my $result;
                   11276:             if ($state eq 'existingfile') {
                   11277:                 $result=
                   11278:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  11279:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  11280:             } else {
1.984     raeburn  11281:                 $result=
                   11282:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  11283:                                                     $dirpath.
1.1123    raeburn  11284:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  11285:                 if ($result !~ m|^/uploaded/|) {
                   11286:                     $output .= '<span class="LC_error">'
                   11287:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11288:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11289:                                .'</span><br />';
                   11290:                     next;
                   11291:                 } else {
1.987     raeburn  11292:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11293:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  11294:                 }
1.661     raeburn  11295:             }
1.1123    raeburn  11296:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  11297:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   11298:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  11299:             my $result =
1.1126    raeburn  11300:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  11301:             if ($result !~ m|^/uploaded/|) {
                   11302:                 $output .= '<span class="LC_error">'
                   11303:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11304:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11305:                            .'</span><br />';
                   11306:                     next;
                   11307:             } else {
                   11308:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11309:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  11310:                 if ($context eq 'syllabus') {
                   11311:                     &Apache::lonnet::make_public_indefinitely($result);
                   11312:                 }
1.987     raeburn  11313:             }
1.661     raeburn  11314:         } else {
                   11315: # Save the file
                   11316:             my $target = $env{'form.embedded_item_'.$i};
                   11317:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   11318:             my $dest = $fullpath.$fname;
                   11319:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  11320:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  11321:             my $count;
                   11322:             my $filepath = $dir_root;
1.1027    raeburn  11323:             foreach my $subdir (@parts) {
                   11324:                 $filepath .= "/$subdir";
                   11325:                 if (!-e $filepath) {
1.661     raeburn  11326:                     mkdir($filepath,0770);
                   11327:                 }
                   11328:             }
                   11329:             my $fh;
                   11330:             if (!open($fh,'>'.$dest)) {
                   11331:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   11332:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  11333:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   11334:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11335:                            '</span><br />';
                   11336:             } else {
                   11337:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   11338:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   11339:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  11340:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   11341:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11342:                               '</span><br />';
                   11343:                 } else {
1.987     raeburn  11344:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11345:                                $url.'</span>').'<br />';
                   11346:                     unless ($context eq 'testbank') {
                   11347:                         $footer .= &mt('View embedded file: [_1]',
                   11348:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   11349:                     }
                   11350:                 }
                   11351:                 close($fh);
                   11352:             }
                   11353:         }
                   11354:         if ($env{'form.embedded_ref_'.$i}) {
                   11355:             $pathchange{$i} = 1;
                   11356:         }
                   11357:     }
                   11358:     if ($output) {
                   11359:         $output = '<p>'.$output.'</p>';
                   11360:     }
                   11361:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   11362:     $returnflag = 'ok';
1.1071    raeburn  11363:     my $numpathchgs = scalar(keys(%pathchange));
                   11364:     if ($numpathchgs > 0) {
1.987     raeburn  11365:         if ($context eq 'portfolio') {
                   11366:             $output .= '<p>'.&mt('or').'</p>';
                   11367:         } elsif ($context eq 'testbank') {
1.1071    raeburn  11368:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   11369:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  11370:             $returnflag = 'modify_orightml';
                   11371:         }
                   11372:     }
1.1071    raeburn  11373:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  11374: }
                   11375: 
                   11376: sub modify_html_form {
                   11377:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   11378:     my $end = 0;
                   11379:     my $modifyform;
                   11380:     if ($context eq 'upload_embedded') {
                   11381:         return unless (ref($pathchange) eq 'HASH');
                   11382:         if ($env{'form.number_embedded_items'}) {
                   11383:             $end += $env{'form.number_embedded_items'};
                   11384:         }
                   11385:         if ($env{'form.number_pathchange_items'}) {
                   11386:             $end += $env{'form.number_pathchange_items'};
                   11387:         }
                   11388:         if ($end) {
                   11389:             for (my $i=0; $i<$end; $i++) {
                   11390:                 if ($i < $env{'form.number_embedded_items'}) {
                   11391:                     next unless($pathchange->{$i});
                   11392:                 }
                   11393:                 $modifyform .=
                   11394:                     &start_data_table_row().
                   11395:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   11396:                     'checked="checked" /></td>'.
                   11397:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   11398:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   11399:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   11400:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   11401:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   11402:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   11403:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   11404:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   11405:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   11406:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   11407:                     &end_data_table_row();
1.1071    raeburn  11408:             }
1.987     raeburn  11409:         }
                   11410:     } else {
                   11411:         $modifyform = $pathchgtable;
                   11412:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   11413:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   11414:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11415:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   11416:         }
                   11417:     }
                   11418:     if ($modifyform) {
1.1071    raeburn  11419:         if ($actionurl eq '/adm/dependencies') {
                   11420:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   11421:         }
1.987     raeburn  11422:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   11423:                '<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".
                   11424:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   11425:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   11426:                '</ol></p>'."\n".'<p>'.
                   11427:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   11428:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   11429:                &start_data_table()."\n".
                   11430:                &start_data_table_header_row().
                   11431:                '<th>'.&mt('Change?').'</th>'.
                   11432:                '<th>'.&mt('Current reference').'</th>'.
                   11433:                '<th>'.&mt('Required reference').'</th>'.
                   11434:                &end_data_table_header_row()."\n".
                   11435:                $modifyform.
                   11436:                &end_data_table().'<br />'."\n".$hiddenstate.
                   11437:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   11438:                '</form>'."\n";
                   11439:     }
                   11440:     return;
                   11441: }
                   11442: 
                   11443: sub modify_html_refs {
1.1123    raeburn  11444:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  11445:     my $container;
                   11446:     if ($context eq 'portfolio') {
                   11447:         $container = $env{'form.container'};
                   11448:     } elsif ($context eq 'coursedoc') {
                   11449:         $container = $env{'form.primaryurl'};
1.1071    raeburn  11450:     } elsif ($context eq 'manage_dependencies') {
                   11451:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   11452:         $container = "/$container";
1.1123    raeburn  11453:     } elsif ($context eq 'syllabus') {
                   11454:         $container = $url;
1.987     raeburn  11455:     } else {
1.1027    raeburn  11456:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  11457:     }
                   11458:     my (%allfiles,%codebase,$output,$content);
                   11459:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  11460:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  11461:         if (wantarray) {
                   11462:             return ('',0,0); 
                   11463:         } else {
                   11464:             return;
                   11465:         }
                   11466:     }
                   11467:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11468:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  11469:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   11470:             if (wantarray) {
                   11471:                 return ('',0,0);
                   11472:             } else {
                   11473:                 return;
                   11474:             }
                   11475:         } 
1.987     raeburn  11476:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  11477:         if ($content eq '-1') {
                   11478:             if (wantarray) {
                   11479:                 return ('',0,0);
                   11480:             } else {
                   11481:                 return;
                   11482:             }
                   11483:         }
1.987     raeburn  11484:     } else {
1.1071    raeburn  11485:         unless ($container =~ /^\Q$dir_root\E/) {
                   11486:             if (wantarray) {
                   11487:                 return ('',0,0);
                   11488:             } else {
                   11489:                 return;
                   11490:             }
                   11491:         } 
1.987     raeburn  11492:         if (open(my $fh,"<$container")) {
                   11493:             $content = join('', <$fh>);
                   11494:             close($fh);
                   11495:         } else {
1.1071    raeburn  11496:             if (wantarray) {
                   11497:                 return ('',0,0);
                   11498:             } else {
                   11499:                 return;
                   11500:             }
1.987     raeburn  11501:         }
                   11502:     }
                   11503:     my ($count,$codebasecount) = (0,0);
                   11504:     my $mm = new File::MMagic;
                   11505:     my $mime_type = $mm->checktype_contents($content);
                   11506:     if ($mime_type eq 'text/html') {
                   11507:         my $parse_result = 
                   11508:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   11509:                                                     \%codebase,\$content);
                   11510:         if ($parse_result eq 'ok') {
                   11511:             foreach my $i (@changes) {
                   11512:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   11513:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   11514:                 if ($allfiles{$ref}) {
                   11515:                     my $newname =  $orig;
                   11516:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  11517:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  11518:                     if ($attrib_regexp =~ /:/) {
                   11519:                         $attrib_regexp =~ s/\:/|/g;
                   11520:                     }
                   11521:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11522:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11523:                         $count += $numchg;
1.1123    raeburn  11524:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  11525:                         delete($allfiles{$ref});
1.987     raeburn  11526:                     }
                   11527:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  11528:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  11529:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   11530:                         $codebasecount ++;
                   11531:                     }
                   11532:                 }
                   11533:             }
1.1123    raeburn  11534:             my $skiprewrites;
1.987     raeburn  11535:             if ($count || $codebasecount) {
                   11536:                 my $saveresult;
1.1071    raeburn  11537:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11538:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  11539:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11540:                     if ($url eq $container) {
                   11541:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   11542:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11543:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  11544:                                             $fname.'</span>').'</p>';
1.987     raeburn  11545:                     } else {
                   11546:                          $output = '<p class="LC_error">'.
                   11547:                                    &mt('Error: update failed for: [_1].',
                   11548:                                    '<span class="LC_filename">'.
                   11549:                                    $container.'</span>').'</p>';
                   11550:                     }
1.1123    raeburn  11551:                     if ($context eq 'syllabus') {
                   11552:                         unless ($saveresult eq 'ok') {
                   11553:                             $skiprewrites = 1;
                   11554:                         }
                   11555:                     }
1.987     raeburn  11556:                 } else {
                   11557:                     if (open(my $fh,">$container")) {
                   11558:                         print $fh $content;
                   11559:                         close($fh);
                   11560:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11561:                                   $count,'<span class="LC_filename">'.
                   11562:                                   $container.'</span>').'</p>';
1.661     raeburn  11563:                     } else {
1.987     raeburn  11564:                          $output = '<p class="LC_error">'.
                   11565:                                    &mt('Error: could not update [_1].',
                   11566:                                    '<span class="LC_filename">'.
                   11567:                                    $container.'</span>').'</p>';
1.661     raeburn  11568:                     }
                   11569:                 }
                   11570:             }
1.1123    raeburn  11571:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   11572:                 my ($actionurl,$state);
                   11573:                 $actionurl = "/public/$udom/$uname/syllabus";
                   11574:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   11575:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   11576:                                               \%codebase,
                   11577:                                               {'context' => 'rewrites',
                   11578:                                                'ignore_remote_references' => 1,});
                   11579:                 if (ref($mapping) eq 'HASH') {
                   11580:                     my $rewrites = 0;
                   11581:                     foreach my $key (keys(%{$mapping})) {
                   11582:                         next if ($key =~ m{^https?://});
                   11583:                         my $ref = $mapping->{$key};
                   11584:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   11585:                         my $attrib;
                   11586:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   11587:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   11588:                         }
                   11589:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11590:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11591:                             $rewrites += $numchg;
                   11592:                         }
                   11593:                     }
                   11594:                     if ($rewrites) {
                   11595:                         my $saveresult; 
                   11596:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11597:                         if ($url eq $container) {
                   11598:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   11599:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   11600:                                             $count,'<span class="LC_filename">'.
                   11601:                                             $fname.'</span>').'</p>';
                   11602:                         } else {
                   11603:                             $output .= '<p class="LC_error">'.
                   11604:                                        &mt('Error: could not update links in [_1].',
                   11605:                                        '<span class="LC_filename">'.
                   11606:                                        $container.'</span>').'</p>';
                   11607: 
                   11608:                         }
                   11609:                     }
                   11610:                 }
                   11611:             }
1.987     raeburn  11612:         } else {
                   11613:             &logthis('Failed to parse '.$container.
                   11614:                      ' to modify references: '.$parse_result);
1.661     raeburn  11615:         }
                   11616:     }
1.1071    raeburn  11617:     if (wantarray) {
                   11618:         return ($output,$count,$codebasecount);
                   11619:     } else {
                   11620:         return $output;
                   11621:     }
1.661     raeburn  11622: }
                   11623: 
                   11624: sub check_for_existing {
                   11625:     my ($path,$fname,$element) = @_;
                   11626:     my ($state,$msg);
                   11627:     if (-d $path.'/'.$fname) {
                   11628:         $state = 'exists';
                   11629:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11630:     } elsif (-e $path.'/'.$fname) {
                   11631:         $state = 'exists';
                   11632:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11633:     }
                   11634:     if ($state eq 'exists') {
                   11635:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   11636:     }
                   11637:     return ($state,$msg);
                   11638: }
                   11639: 
                   11640: sub check_for_upload {
                   11641:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   11642:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  11643:     my $filesize = length($env{'form.'.$element});
                   11644:     if (!$filesize) {
                   11645:         my $msg = '<span class="LC_error">'.
                   11646:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   11647:                       '<span class="LC_filename">'.$fname.'</span>',
                   11648:                       $filesize).'<br />'.
1.1007    raeburn  11649:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  11650:                   '</span>';
                   11651:         return ('zero_bytes',$msg);
                   11652:     }
                   11653:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  11654:     my $getpropath = 1;
1.1021    raeburn  11655:     my ($dirlistref,$listerror) =
                   11656:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  11657:     my $found_file = 0;
                   11658:     my $locked_file = 0;
1.991     raeburn  11659:     my @lockers;
                   11660:     my $navmap;
                   11661:     if ($env{'request.course.id'}) {
                   11662:         $navmap = Apache::lonnavmaps::navmap->new();
                   11663:     }
1.1021    raeburn  11664:     if (ref($dirlistref) eq 'ARRAY') {
                   11665:         foreach my $line (@{$dirlistref}) {
                   11666:             my ($file_name,$rest)=split(/\&/,$line,2);
                   11667:             if ($file_name eq $fname){
                   11668:                 $file_name = $path.$file_name;
                   11669:                 if ($group ne '') {
                   11670:                     $file_name = $group.$file_name;
                   11671:                 }
                   11672:                 $found_file = 1;
                   11673:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   11674:                     foreach my $lock (@lockers) {
                   11675:                         if (ref($lock) eq 'ARRAY') {
                   11676:                             my ($symb,$crsid) = @{$lock};
                   11677:                             if ($crsid eq $env{'request.course.id'}) {
                   11678:                                 if (ref($navmap)) {
                   11679:                                     my $res = $navmap->getBySymb($symb);
                   11680:                                     foreach my $part (@{$res->parts()}) { 
                   11681:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   11682:                                         unless (($slot_status == $res->RESERVED) ||
                   11683:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   11684:                                             $locked_file = 1;
                   11685:                                         }
1.991     raeburn  11686:                                     }
1.1021    raeburn  11687:                                 } else {
                   11688:                                     $locked_file = 1;
1.991     raeburn  11689:                                 }
                   11690:                             } else {
                   11691:                                 $locked_file = 1;
                   11692:                             }
                   11693:                         }
1.1021    raeburn  11694:                    }
                   11695:                 } else {
                   11696:                     my @info = split(/\&/,$rest);
                   11697:                     my $currsize = $info[6]/1000;
                   11698:                     if ($currsize < $filesize) {
                   11699:                         my $extra = $filesize - $currsize;
                   11700:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   11701:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  11702:                                       &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   11703:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   11704:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   11705:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  11706:                             return ('will_exceed_quota',$msg);
                   11707:                         }
1.984     raeburn  11708:                     }
                   11709:                 }
1.661     raeburn  11710:             }
                   11711:         }
                   11712:     }
                   11713:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   11714:         my $msg = '<p class="LC_warning">'.
                   11715:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184    raeburn  11716:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  11717:         return ('will_exceed_quota',$msg);
                   11718:     } elsif ($found_file) {
                   11719:         if ($locked_file) {
1.1179    bisitz   11720:             my $msg = '<p class="LC_warning">';
1.661     raeburn  11721:             $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   11722:             $msg .= '</p>';
1.661     raeburn  11723:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   11724:             return ('file_locked',$msg);
                   11725:         } else {
1.1179    bisitz   11726:             my $msg = '<p class="LC_error">';
1.984     raeburn  11727:             $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   11728:             $msg .= '</p>';
1.984     raeburn  11729:             return ('existingfile',$msg);
1.661     raeburn  11730:         }
                   11731:     }
                   11732: }
                   11733: 
1.987     raeburn  11734: sub check_for_traversal {
                   11735:     my ($path,$url,$toplevel) = @_;
                   11736:     my @parts=split(/\//,$path);
                   11737:     my $cleanpath;
                   11738:     my $fullpath = $url;
                   11739:     for (my $i=0;$i<@parts;$i++) {
                   11740:         next if ($parts[$i] eq '.');
                   11741:         if ($parts[$i] eq '..') {
                   11742:             $fullpath =~ s{([^/]+/)$}{};
                   11743:         } else {
                   11744:             $fullpath .= $parts[$i].'/';
                   11745:         }
                   11746:     }
                   11747:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   11748:         $cleanpath = $1;
                   11749:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11750:         my $curr_toprel = $1;
                   11751:         my @parts = split(/\//,$curr_toprel);
                   11752:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11753:         my @urlparts = split(/\//,$url_toprel);
                   11754:         my $doubledots;
                   11755:         my $startdiff = -1;
                   11756:         for (my $i=0; $i<@urlparts; $i++) {
                   11757:             if ($startdiff == -1) {
                   11758:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11759:                     $startdiff = $i;
                   11760:                     $doubledots .= '../';
                   11761:                 }
                   11762:             } else {
                   11763:                 $doubledots .= '../';
                   11764:             }
                   11765:         }
                   11766:         if ($startdiff > -1) {
                   11767:             $cleanpath = $doubledots;
                   11768:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11769:                 $cleanpath .= $parts[$i].'/';
                   11770:             }
                   11771:         }
                   11772:     }
                   11773:     $cleanpath =~ s{(/)$}{};
                   11774:     return $cleanpath;
                   11775: }
1.31      albertel 11776: 
1.1053    raeburn  11777: sub is_archive_file {
                   11778:     my ($mimetype) = @_;
                   11779:     if (($mimetype eq 'application/octet-stream') ||
                   11780:         ($mimetype eq 'application/x-stuffit') ||
                   11781:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11782:         return 1;
                   11783:     }
                   11784:     return;
                   11785: }
                   11786: 
                   11787: sub decompress_form {
1.1065    raeburn  11788:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11789:     my %lt = &Apache::lonlocal::texthash (
                   11790:         this => 'This file is an archive file.',
1.1067    raeburn  11791:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11792:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11793:         youm => 'You may wish to extract its contents.',
                   11794:         extr => 'Extract contents',
1.1067    raeburn  11795:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11796:         proa => 'Process automatically?',
1.1053    raeburn  11797:         yes  => 'Yes',
                   11798:         no   => 'No',
1.1067    raeburn  11799:         fold => 'Title for folder containing movie',
                   11800:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11801:     );
1.1065    raeburn  11802:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11803:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11804:     my $info = &list_archive_contents($fileloc,\@paths);
                   11805:     if (@paths) {
                   11806:         foreach my $path (@paths) {
                   11807:             $path =~ s{^/}{};
1.1067    raeburn  11808:             if ($path =~ m{^([^/]+)/$}) {
                   11809:                 $topdir = $1;
                   11810:             }
1.1065    raeburn  11811:             if ($path =~ m{^([^/]+)/}) {
                   11812:                 $toplevel{$1} = $path;
                   11813:             } else {
                   11814:                 $toplevel{$path} = $path;
                   11815:             }
                   11816:         }
                   11817:     }
1.1067    raeburn  11818:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  11819:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11820:                         "$topdir/media/",
                   11821:                         "$topdir/media/$topdir.mp4",
                   11822:                         "$topdir/media/FirstFrame.png",
                   11823:                         "$topdir/media/player.swf",
                   11824:                         "$topdir/media/swfobject.js",
                   11825:                         "$topdir/media/expressInstall.swf");
1.1197    raeburn  11826:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164    raeburn  11827:                          "$topdir/$topdir.mp4",
                   11828:                          "$topdir/$topdir\_config.xml",
                   11829:                          "$topdir/$topdir\_controller.swf",
                   11830:                          "$topdir/$topdir\_embed.css",
                   11831:                          "$topdir/$topdir\_First_Frame.png",
                   11832:                          "$topdir/$topdir\_player.html",
                   11833:                          "$topdir/$topdir\_Thumbnails.png",
                   11834:                          "$topdir/playerProductInstall.swf",
                   11835:                          "$topdir/scripts/",
                   11836:                          "$topdir/scripts/config_xml.js",
                   11837:                          "$topdir/scripts/handlebars.js",
                   11838:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11839:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11840:                          "$topdir/scripts/modernizr.js",
                   11841:                          "$topdir/scripts/player-min.js",
                   11842:                          "$topdir/scripts/swfobject.js",
                   11843:                          "$topdir/skins/",
                   11844:                          "$topdir/skins/configuration_express.xml",
                   11845:                          "$topdir/skins/express_show/",
                   11846:                          "$topdir/skins/express_show/player-min.css",
                   11847:                          "$topdir/skins/express_show/spritesheet.png");
1.1197    raeburn  11848:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11849:                          "$topdir/$topdir.mp4",
                   11850:                          "$topdir/$topdir\_config.xml",
                   11851:                          "$topdir/$topdir\_controller.swf",
                   11852:                          "$topdir/$topdir\_embed.css",
                   11853:                          "$topdir/$topdir\_First_Frame.png",
                   11854:                          "$topdir/$topdir\_player.html",
                   11855:                          "$topdir/$topdir\_Thumbnails.png",
                   11856:                          "$topdir/playerProductInstall.swf",
                   11857:                          "$topdir/scripts/",
                   11858:                          "$topdir/scripts/config_xml.js",
                   11859:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11860:                          "$topdir/skins/",
                   11861:                          "$topdir/skins/configuration_express.xml",
                   11862:                          "$topdir/skins/express_show/",
                   11863:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11864:                          "$topdir/skins/express_show/spritesheet.png",
                   11865:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164    raeburn  11866:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11867:         if (@diffs == 0) {
1.1164    raeburn  11868:             $is_camtasia = 6;
                   11869:         } else {
1.1197    raeburn  11870:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164    raeburn  11871:             if (@diffs == 0) {
                   11872:                 $is_camtasia = 8;
1.1197    raeburn  11873:             } else {
                   11874:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11875:                 if (@diffs == 0) {
                   11876:                     $is_camtasia = 8;
                   11877:                 }
1.1164    raeburn  11878:             }
1.1067    raeburn  11879:         }
                   11880:     }
                   11881:     my $output;
                   11882:     if ($is_camtasia) {
                   11883:         $output = <<"ENDCAM";
                   11884: <script type="text/javascript" language="Javascript">
                   11885: // <![CDATA[
                   11886: 
                   11887: function camtasiaToggle() {
                   11888:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11889:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  11890:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11891:                 document.getElementById('camtasia_titles').style.display='block';
                   11892:             } else {
                   11893:                 document.getElementById('camtasia_titles').style.display='none';
                   11894:             }
                   11895:         }
                   11896:     }
                   11897:     return;
                   11898: }
                   11899: 
                   11900: // ]]>
                   11901: </script>
                   11902: <p>$lt{'camt'}</p>
                   11903: ENDCAM
1.1065    raeburn  11904:     } else {
1.1067    raeburn  11905:         $output = '<p>'.$lt{'this'};
                   11906:         if ($info eq '') {
                   11907:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11908:         } else {
                   11909:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11910:                        '<div><pre>'.$info.'</pre></div>';
                   11911:         }
1.1065    raeburn  11912:     }
1.1067    raeburn  11913:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11914:     my $duplicates;
                   11915:     my $num = 0;
                   11916:     if (ref($dirlist) eq 'ARRAY') {
                   11917:         foreach my $item (@{$dirlist}) {
                   11918:             if (ref($item) eq 'ARRAY') {
                   11919:                 if (exists($toplevel{$item->[0]})) {
                   11920:                     $duplicates .= 
                   11921:                         &start_data_table_row().
                   11922:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11923:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11924:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11925:                         'value="1" />'.&mt('Yes').'</label>'.
                   11926:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11927:                         '<td>'.$item->[0].'</td>';
                   11928:                     if ($item->[2]) {
                   11929:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11930:                     } else {
                   11931:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11932:                     }
                   11933:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11934:                                    '<td>'.
                   11935:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11936:                                    '</td>'.
                   11937:                                    &end_data_table_row();
                   11938:                     $num ++;
                   11939:                 }
                   11940:             }
                   11941:         }
                   11942:     }
                   11943:     my $itemcount;
                   11944:     if (@paths > 0) {
                   11945:         $itemcount = scalar(@paths);
                   11946:     } else {
                   11947:         $itemcount = 1;
                   11948:     }
1.1067    raeburn  11949:     if ($is_camtasia) {
                   11950:         $output .= $lt{'auto'}.'<br />'.
                   11951:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  11952:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11953:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11954:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11955:                    $lt{'no'}.'</label></span><br />'.
                   11956:                    '<div id="camtasia_titles" style="display:block">'.
                   11957:                    &Apache::lonhtmlcommon::start_pick_box().
                   11958:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11959:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11960:                    &Apache::lonhtmlcommon::row_closure().
                   11961:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11962:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11963:                    &Apache::lonhtmlcommon::row_closure(1).
                   11964:                    &Apache::lonhtmlcommon::end_pick_box().
                   11965:                    '</div>';
                   11966:     }
1.1065    raeburn  11967:     $output .= 
                   11968:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11969:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11970:         "\n";
1.1065    raeburn  11971:     if ($duplicates ne '') {
                   11972:         $output .= '<p><span class="LC_warning">'.
                   11973:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11974:                    &start_data_table().
                   11975:                    &start_data_table_header_row().
                   11976:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11977:                    '<th>'.&mt('Name').'</th>'.
                   11978:                    '<th>'.&mt('Type').'</th>'.
                   11979:                    '<th>'.&mt('Size').'</th>'.
                   11980:                    '<th>'.&mt('Last modified').'</th>'.
                   11981:                    &end_data_table_header_row().
                   11982:                    $duplicates.
                   11983:                    &end_data_table().
                   11984:                    '</p>';
                   11985:     }
1.1067    raeburn  11986:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11987:     if (ref($hiddenelements) eq 'HASH') {
                   11988:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11989:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11990:         }
                   11991:     }
                   11992:     $output .= <<"END";
1.1067    raeburn  11993: <br />
1.1053    raeburn  11994: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11995: </form>
                   11996: $noextract
                   11997: END
                   11998:     return $output;
                   11999: }
                   12000: 
1.1065    raeburn  12001: sub decompression_utility {
                   12002:     my ($program) = @_;
                   12003:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   12004:     my $location;
                   12005:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   12006:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   12007:                          '/usr/sbin/') {
                   12008:             if (-x $dir.$program) {
                   12009:                 $location = $dir.$program;
                   12010:                 last;
                   12011:             }
                   12012:         }
                   12013:     }
                   12014:     return $location;
                   12015: }
                   12016: 
                   12017: sub list_archive_contents {
                   12018:     my ($file,$pathsref) = @_;
                   12019:     my (@cmd,$output);
                   12020:     my $needsregexp;
                   12021:     if ($file =~ /\.zip$/) {
                   12022:         @cmd = (&decompression_utility('unzip'),"-l");
                   12023:         $needsregexp = 1;
                   12024:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   12025:              ($file =~ /\.tgz$/)) {
                   12026:         @cmd = (&decompression_utility('tar'),"-ztf");
                   12027:     } elsif ($file =~ /\.tar\.bz2$/) {
                   12028:         @cmd = (&decompression_utility('tar'),"-jtf");
                   12029:     } elsif ($file =~ m|\.tar$|) {
                   12030:         @cmd = (&decompression_utility('tar'),"-tf");
                   12031:     }
                   12032:     if (@cmd) {
                   12033:         undef($!);
                   12034:         undef($@);
                   12035:         if (open(my $fh,"-|", @cmd, $file)) {
                   12036:             while (my $line = <$fh>) {
                   12037:                 $output .= $line;
                   12038:                 chomp($line);
                   12039:                 my $item;
                   12040:                 if ($needsregexp) {
                   12041:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   12042:                 } else {
                   12043:                     $item = $line;
                   12044:                 }
                   12045:                 if ($item ne '') {
                   12046:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   12047:                         push(@{$pathsref},$item);
                   12048:                     } 
                   12049:                 }
                   12050:             }
                   12051:             close($fh);
                   12052:         }
                   12053:     }
                   12054:     return $output;
                   12055: }
                   12056: 
1.1053    raeburn  12057: sub decompress_uploaded_file {
                   12058:     my ($file,$dir) = @_;
                   12059:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   12060:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   12061:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   12062:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   12063:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   12064:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   12065:     my $decompressed = $env{'cgi.decompressed'};
                   12066:     &Apache::lonnet::delenv('cgi.file');
                   12067:     &Apache::lonnet::delenv('cgi.dir');
                   12068:     &Apache::lonnet::delenv('cgi.decompressed');
                   12069:     return ($decompressed,$result);
                   12070: }
                   12071: 
1.1055    raeburn  12072: sub process_decompression {
                   12073:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   12074:     my ($dir,$error,$warning,$output);
1.1180    raeburn  12075:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   12076:         $error = &mt('Filename not a supported archive file type.').
                   12077:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  12078:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   12079:     } else {
                   12080:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12081:         if ($docuhome eq 'no_host') {
                   12082:             $error = &mt('Could not determine home server for course.');
                   12083:         } else {
                   12084:             my @ids=&Apache::lonnet::current_machine_ids();
                   12085:             my $currdir = "$dir_root/$destination";
                   12086:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12087:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   12088:                        "$dir_root/$destination";
                   12089:             } else {
                   12090:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   12091:                        "$dir_root/$docudom/$docuname/$destination";
                   12092:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   12093:                     $error = &mt('Archive file not found.');
                   12094:                 }
                   12095:             }
1.1065    raeburn  12096:             my (@to_overwrite,@to_skip);
                   12097:             if ($env{'form.archive_overwrite_total'} > 0) {
                   12098:                 my $total = $env{'form.archive_overwrite_total'};
                   12099:                 for (my $i=0; $i<$total; $i++) {
                   12100:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   12101:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   12102:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   12103:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   12104:                     }
                   12105:                 }
                   12106:             }
                   12107:             my $numskip = scalar(@to_skip);
                   12108:             if (($numskip > 0) && 
                   12109:                 ($numskip == $env{'form.archive_itemcount'})) {
                   12110:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   12111:             } elsif ($dir eq '') {
1.1055    raeburn  12112:                 $error = &mt('Directory containing archive file unavailable.');
                   12113:             } elsif (!$error) {
1.1065    raeburn  12114:                 my ($decompressed,$display);
                   12115:                 if ($numskip > 0) {
                   12116:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   12117:                     mkdir("$dir/$tempdir",0755);
                   12118:                     system("mv $dir/$file $dir/$tempdir/$file");
                   12119:                     ($decompressed,$display) = 
                   12120:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   12121:                     foreach my $item (@to_skip) {
                   12122:                         if (($item ne '') && ($item !~ /\.\./)) {
                   12123:                             if (-f "$dir/$tempdir/$item") { 
                   12124:                                 unlink("$dir/$tempdir/$item");
                   12125:                             } elsif (-d "$dir/$tempdir/$item") {
                   12126:                                 system("rm -rf $dir/$tempdir/$item");
                   12127:                             }
                   12128:                         }
                   12129:                     }
                   12130:                     system("mv $dir/$tempdir/* $dir");
                   12131:                     rmdir("$dir/$tempdir");   
                   12132:                 } else {
                   12133:                     ($decompressed,$display) = 
                   12134:                         &decompress_uploaded_file($file,$dir);
                   12135:                 }
1.1055    raeburn  12136:                 if ($decompressed eq 'ok') {
1.1065    raeburn  12137:                     $output = '<p class="LC_info">'.
                   12138:                               &mt('Files extracted successfully from archive.').
                   12139:                               '</p>'."\n";
1.1055    raeburn  12140:                     my ($warning,$result,@contents);
                   12141:                     my ($newdirlistref,$newlisterror) =
                   12142:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   12143:                                                  $docuname,1);
                   12144:                     my (%is_dir,%changes,@newitems);
                   12145:                     my $dirptr = 16384;
1.1065    raeburn  12146:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  12147:                         foreach my $dir_line (@{$newdirlistref}) {
                   12148:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  12149:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   12150:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  12151:                                 push(@newitems,$item);
                   12152:                                 if ($dirptr&$testdir) {
                   12153:                                     $is_dir{$item} = 1;
                   12154:                                 }
                   12155:                                 $changes{$item} = 1;
                   12156:                             }
                   12157:                         }
                   12158:                     }
                   12159:                     if (keys(%changes) > 0) {
                   12160:                         foreach my $item (sort(@newitems)) {
                   12161:                             if ($changes{$item}) {
                   12162:                                 push(@contents,$item);
                   12163:                             }
                   12164:                         }
                   12165:                     }
                   12166:                     if (@contents > 0) {
1.1067    raeburn  12167:                         my $wantform;
                   12168:                         unless ($env{'form.autoextract_camtasia'}) {
                   12169:                             $wantform = 1;
                   12170:                         }
1.1056    raeburn  12171:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  12172:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   12173:                                                                 $currdir,\%is_dir,
                   12174:                                                                 \%children,\%parent,
1.1056    raeburn  12175:                                                                 \@contents,\%dirorder,
                   12176:                                                                 \%titles,$wantform);
1.1055    raeburn  12177:                         if ($datatable ne '') {
                   12178:                             $output .= &archive_options_form('decompressed',$datatable,
                   12179:                                                              $count,$hiddenelem);
1.1065    raeburn  12180:                             my $startcount = 6;
1.1055    raeburn  12181:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  12182:                                                            \%titles,\%children);
1.1055    raeburn  12183:                         }
1.1067    raeburn  12184:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  12185:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  12186:                             my %displayed;
                   12187:                             my $total = 1;
                   12188:                             $env{'form.archive_directory'} = [];
                   12189:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   12190:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   12191:                                 $path =~ s{/$}{};
                   12192:                                 my $item;
                   12193:                                 if ($path ne '') {
                   12194:                                     $item = "$path/$titles{$i}";
                   12195:                                 } else {
                   12196:                                     $item = $titles{$i};
                   12197:                                 }
                   12198:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   12199:                                 if ($item eq $contents[0]) {
                   12200:                                     push(@{$env{'form.archive_directory'}},$i);
                   12201:                                     $env{'form.archive_'.$i} = 'display';
                   12202:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   12203:                                     $displayed{'folder'} = $i;
1.1164    raeburn  12204:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   12205:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  12206:                                     $env{'form.archive_'.$i} = 'display';
                   12207:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   12208:                                     $displayed{'web'} = $i;
                   12209:                                 } else {
1.1164    raeburn  12210:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   12211:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   12212:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  12213:                                         push(@{$env{'form.archive_directory'}},$i);
                   12214:                                     }
                   12215:                                     $env{'form.archive_'.$i} = 'dependency';
                   12216:                                 }
                   12217:                                 $total ++;
                   12218:                             }
                   12219:                             for (my $i=1; $i<$total; $i++) {
                   12220:                                 next if ($i == $displayed{'web'});
                   12221:                                 next if ($i == $displayed{'folder'});
                   12222:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   12223:                             }
                   12224:                             $env{'form.phase'} = 'decompress_cleanup';
                   12225:                             $env{'form.archivedelete'} = 1;
                   12226:                             $env{'form.archive_count'} = $total-1;
                   12227:                             $output .=
                   12228:                                 &process_extracted_files('coursedocs',$docudom,
                   12229:                                                          $docuname,$destination,
                   12230:                                                          $dir_root,$hiddenelem);
                   12231:                         }
1.1055    raeburn  12232:                     } else {
                   12233:                         $warning = &mt('No new items extracted from archive file.');
                   12234:                     }
                   12235:                 } else {
                   12236:                     $output = $display;
                   12237:                     $error = &mt('An error occurred during extraction from the archive file.');
                   12238:                 }
                   12239:             }
                   12240:         }
                   12241:     }
                   12242:     if ($error) {
                   12243:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12244:                    $error.'</p>'."\n";
                   12245:     }
                   12246:     if ($warning) {
                   12247:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12248:     }
                   12249:     return $output;
                   12250: }
                   12251: 
                   12252: sub get_extracted {
1.1056    raeburn  12253:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   12254:         $titles,$wantform) = @_;
1.1055    raeburn  12255:     my $count = 0;
                   12256:     my $depth = 0;
                   12257:     my $datatable;
1.1056    raeburn  12258:     my @hierarchy;
1.1055    raeburn  12259:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  12260:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   12261:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  12262:     foreach my $item (@{$contents}) {
                   12263:         $count ++;
1.1056    raeburn  12264:         @{$dirorder->{$count}} = @hierarchy;
                   12265:         $titles->{$count} = $item;
1.1055    raeburn  12266:         &archive_hierarchy($depth,$count,$parent,$children);
                   12267:         if ($wantform) {
                   12268:             $datatable .= &archive_row($is_dir->{$item},$item,
                   12269:                                        $currdir,$depth,$count);
                   12270:         }
                   12271:         if ($is_dir->{$item}) {
                   12272:             $depth ++;
1.1056    raeburn  12273:             push(@hierarchy,$count);
                   12274:             $parent->{$depth} = $count;
1.1055    raeburn  12275:             $datatable .=
                   12276:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  12277:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   12278:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  12279:             $depth --;
1.1056    raeburn  12280:             pop(@hierarchy);
1.1055    raeburn  12281:         }
                   12282:     }
                   12283:     return ($count,$datatable);
                   12284: }
                   12285: 
                   12286: sub recurse_extracted_archive {
1.1056    raeburn  12287:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   12288:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  12289:     my $result='';
1.1056    raeburn  12290:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   12291:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   12292:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  12293:         return $result;
                   12294:     }
                   12295:     my $dirptr = 16384;
                   12296:     my ($newdirlistref,$newlisterror) =
                   12297:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   12298:     if (ref($newdirlistref) eq 'ARRAY') {
                   12299:         foreach my $dir_line (@{$newdirlistref}) {
                   12300:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   12301:             unless ($item =~ /^\.+$/) {
                   12302:                 $$count ++;
1.1056    raeburn  12303:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   12304:                 $titles->{$$count} = $item;
1.1055    raeburn  12305:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  12306: 
1.1055    raeburn  12307:                 my $is_dir;
                   12308:                 if ($dirptr&$testdir) {
                   12309:                     $is_dir = 1;
                   12310:                 }
                   12311:                 if ($wantform) {
                   12312:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   12313:                 }
                   12314:                 if ($is_dir) {
                   12315:                     $$depth ++;
1.1056    raeburn  12316:                     push(@{$hierarchy},$$count);
                   12317:                     $parent->{$$depth} = $$count;
1.1055    raeburn  12318:                     $result .=
                   12319:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   12320:                                                    $docuname,$depth,$count,
1.1056    raeburn  12321:                                                    $hierarchy,$dirorder,$children,
                   12322:                                                    $parent,$titles,$wantform);
1.1055    raeburn  12323:                     $$depth --;
1.1056    raeburn  12324:                     pop(@{$hierarchy});
1.1055    raeburn  12325:                 }
                   12326:             }
                   12327:         }
                   12328:     }
                   12329:     return $result;
                   12330: }
                   12331: 
                   12332: sub archive_hierarchy {
                   12333:     my ($depth,$count,$parent,$children) =@_;
                   12334:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   12335:         if (exists($parent->{$depth})) {
                   12336:              $children->{$parent->{$depth}} .= $count.':';
                   12337:         }
                   12338:     }
                   12339:     return;
                   12340: }
                   12341: 
                   12342: sub archive_row {
                   12343:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   12344:     my ($name) = ($item =~ m{([^/]+)$});
                   12345:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  12346:                                        'display'    => 'Add as file',
1.1055    raeburn  12347:                                        'dependency' => 'Include as dependency',
                   12348:                                        'discard'    => 'Discard',
                   12349:                                       );
                   12350:     if ($is_dir) {
1.1059    raeburn  12351:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  12352:     }
1.1056    raeburn  12353:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   12354:     my $offset = 0;
1.1055    raeburn  12355:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  12356:         $offset ++;
1.1065    raeburn  12357:         if ($action ne 'display') {
                   12358:             $offset ++;
                   12359:         }  
1.1055    raeburn  12360:         $output .= '<td><span class="LC_nobreak">'.
                   12361:                    '<label><input type="radio" name="archive_'.$count.
                   12362:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   12363:         my $text = $choices{$action};
                   12364:         if ($is_dir) {
                   12365:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   12366:             if ($action eq 'display') {
1.1059    raeburn  12367:                 $text = &mt('Add as folder');
1.1055    raeburn  12368:             }
1.1056    raeburn  12369:         } else {
                   12370:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   12371: 
                   12372:         }
                   12373:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   12374:         if ($action eq 'dependency') {
                   12375:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   12376:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   12377:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   12378:                        '<option value=""></option>'."\n".
                   12379:                        '</select>'."\n".
                   12380:                        '</div>';
1.1059    raeburn  12381:         } elsif ($action eq 'display') {
                   12382:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   12383:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   12384:                        '</div>';
1.1055    raeburn  12385:         }
1.1056    raeburn  12386:         $output .= '</td>';
1.1055    raeburn  12387:     }
                   12388:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   12389:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   12390:     for (my $i=0; $i<$depth; $i++) {
                   12391:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   12392:     }
                   12393:     if ($is_dir) {
                   12394:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   12395:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   12396:     } else {
                   12397:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   12398:     }
                   12399:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   12400:                &end_data_table_row();
                   12401:     return $output;
                   12402: }
                   12403: 
                   12404: sub archive_options_form {
1.1065    raeburn  12405:     my ($form,$display,$count,$hiddenelem) = @_;
                   12406:     my %lt = &Apache::lonlocal::texthash(
                   12407:                perm => 'Permanently remove archive file?',
                   12408:                hows => 'How should each extracted item be incorporated in the course?',
                   12409:                cont => 'Content actions for all',
                   12410:                addf => 'Add as folder/file',
                   12411:                incd => 'Include as dependency for a displayed file',
                   12412:                disc => 'Discard',
                   12413:                no   => 'No',
                   12414:                yes  => 'Yes',
                   12415:                save => 'Save',
                   12416:     );
                   12417:     my $output = <<"END";
                   12418: <form name="$form" method="post" action="">
                   12419: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   12420: <label>
                   12421:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   12422: </label>
                   12423: &nbsp;
                   12424: <label>
                   12425:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   12426: </span>
                   12427: </p>
                   12428: <input type="hidden" name="phase" value="decompress_cleanup" />
                   12429: <br />$lt{'hows'}
                   12430: <div class="LC_columnSection">
                   12431:   <fieldset>
                   12432:     <legend>$lt{'cont'}</legend>
                   12433:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   12434:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   12435:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   12436:   </fieldset>
                   12437: </div>
                   12438: END
                   12439:     return $output.
1.1055    raeburn  12440:            &start_data_table()."\n".
1.1065    raeburn  12441:            $display."\n".
1.1055    raeburn  12442:            &end_data_table()."\n".
                   12443:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   12444:            $hiddenelem.
1.1065    raeburn  12445:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  12446:            '</form>';
                   12447: }
                   12448: 
                   12449: sub archive_javascript {
1.1056    raeburn  12450:     my ($startcount,$numitems,$titles,$children) = @_;
                   12451:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  12452:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  12453:     my $scripttag = <<START;
                   12454: <script type="text/javascript">
                   12455: // <![CDATA[
                   12456: 
                   12457: function checkAll(form,prefix) {
                   12458:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   12459:     for (var i=0; i < form.elements.length; i++) {
                   12460:         var id = form.elements[i].id;
                   12461:         if ((id != '') && (id != undefined)) {
                   12462:             if (idstr.test(id)) {
                   12463:                 if (form.elements[i].type == 'radio') {
                   12464:                     form.elements[i].checked = true;
1.1056    raeburn  12465:                     var nostart = i-$startcount;
1.1059    raeburn  12466:                     var offset = nostart%7;
                   12467:                     var count = (nostart-offset)/7;    
1.1056    raeburn  12468:                     dependencyCheck(form,count,offset);
1.1055    raeburn  12469:                 }
                   12470:             }
                   12471:         }
                   12472:     }
                   12473: }
                   12474: 
                   12475: function propagateCheck(form,count) {
                   12476:     if (count > 0) {
1.1059    raeburn  12477:         var startelement = $startcount + ((count-1) * 7);
                   12478:         for (var j=1; j<6; j++) {
                   12479:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  12480:                 var item = startelement + j; 
                   12481:                 if (form.elements[item].type == 'radio') {
                   12482:                     if (form.elements[item].checked) {
                   12483:                         containerCheck(form,count,j);
                   12484:                         break;
                   12485:                     }
1.1055    raeburn  12486:                 }
                   12487:             }
                   12488:         }
                   12489:     }
                   12490: }
                   12491: 
                   12492: numitems = $numitems
1.1056    raeburn  12493: var titles = new Array(numitems);
                   12494: var parents = new Array(numitems);
1.1055    raeburn  12495: for (var i=0; i<numitems; i++) {
1.1056    raeburn  12496:     parents[i] = new Array;
1.1055    raeburn  12497: }
1.1059    raeburn  12498: var maintitle = '$maintitle';
1.1055    raeburn  12499: 
                   12500: START
                   12501: 
1.1056    raeburn  12502:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   12503:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  12504:         for (my $i=0; $i<@contents; $i ++) {
                   12505:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   12506:         }
                   12507:     }
                   12508: 
1.1056    raeburn  12509:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   12510:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   12511:     }
                   12512: 
1.1055    raeburn  12513:     $scripttag .= <<END;
                   12514: 
                   12515: function containerCheck(form,count,offset) {
                   12516:     if (count > 0) {
1.1056    raeburn  12517:         dependencyCheck(form,count,offset);
1.1059    raeburn  12518:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  12519:         form.elements[item].checked = true;
                   12520:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12521:             if (parents[count].length > 0) {
                   12522:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  12523:                     containerCheck(form,parents[count][j],offset);
                   12524:                 }
                   12525:             }
                   12526:         }
                   12527:     }
                   12528: }
                   12529: 
                   12530: function dependencyCheck(form,count,offset) {
                   12531:     if (count > 0) {
1.1059    raeburn  12532:         var chosen = (offset+$startcount)+7*(count-1);
                   12533:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  12534:         var currtype = form.elements[depitem].type;
                   12535:         if (form.elements[chosen].value == 'dependency') {
                   12536:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   12537:             form.elements[depitem].options.length = 0;
                   12538:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  12539:             for (var i=1; i<=numitems; i++) {
                   12540:                 if (i == count) {
                   12541:                     continue;
                   12542:                 }
1.1059    raeburn  12543:                 var startelement = $startcount + (i-1) * 7;
                   12544:                 for (var j=1; j<6; j++) {
                   12545:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  12546:                         var item = startelement + j;
                   12547:                         if (form.elements[item].type == 'radio') {
                   12548:                             if (form.elements[item].checked) {
                   12549:                                 if (form.elements[item].value == 'display') {
                   12550:                                     var n = form.elements[depitem].options.length;
                   12551:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   12552:                                 }
                   12553:                             }
                   12554:                         }
                   12555:                     }
                   12556:                 }
                   12557:             }
                   12558:         } else {
                   12559:             document.getElementById('arc_depon_'+count).style.display='none';
                   12560:             form.elements[depitem].options.length = 0;
                   12561:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   12562:         }
1.1059    raeburn  12563:         titleCheck(form,count,offset);
1.1056    raeburn  12564:     }
                   12565: }
                   12566: 
                   12567: function propagateSelect(form,count,offset) {
                   12568:     if (count > 0) {
1.1065    raeburn  12569:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  12570:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   12571:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12572:             if (parents[count].length > 0) {
                   12573:                 for (var j=0; j<parents[count].length; j++) {
                   12574:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  12575:                 }
                   12576:             }
                   12577:         }
                   12578:     }
                   12579: }
1.1056    raeburn  12580: 
                   12581: function containerSelect(form,count,offset,picked) {
                   12582:     if (count > 0) {
1.1065    raeburn  12583:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  12584:         if (form.elements[item].type == 'radio') {
                   12585:             if (form.elements[item].value == 'dependency') {
                   12586:                 if (form.elements[item+1].type == 'select-one') {
                   12587:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   12588:                         if (form.elements[item+1].options[i].value == picked) {
                   12589:                             form.elements[item+1].selectedIndex = i;
                   12590:                             break;
                   12591:                         }
                   12592:                     }
                   12593:                 }
                   12594:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12595:                     if (parents[count].length > 0) {
                   12596:                         for (var j=0; j<parents[count].length; j++) {
                   12597:                             containerSelect(form,parents[count][j],offset,picked);
                   12598:                         }
                   12599:                     }
                   12600:                 }
                   12601:             }
                   12602:         }
                   12603:     }
                   12604: }
                   12605: 
1.1059    raeburn  12606: function titleCheck(form,count,offset) {
                   12607:     if (count > 0) {
                   12608:         var chosen = (offset+$startcount)+7*(count-1);
                   12609:         var depitem = $startcount + ((count-1) * 7) + 2;
                   12610:         var currtype = form.elements[depitem].type;
                   12611:         if (form.elements[chosen].value == 'display') {
                   12612:             document.getElementById('arc_title_'+count).style.display='block';
                   12613:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   12614:                 document.getElementById('archive_title_'+count).value=maintitle;
                   12615:             }
                   12616:         } else {
                   12617:             document.getElementById('arc_title_'+count).style.display='none';
                   12618:             if (currtype == 'text') { 
                   12619:                 document.getElementById('archive_title_'+count).value='';
                   12620:             }
                   12621:         }
                   12622:     }
                   12623:     return;
                   12624: }
                   12625: 
1.1055    raeburn  12626: // ]]>
                   12627: </script>
                   12628: END
                   12629:     return $scripttag;
                   12630: }
                   12631: 
                   12632: sub process_extracted_files {
1.1067    raeburn  12633:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  12634:     my $numitems = $env{'form.archive_count'};
                   12635:     return unless ($numitems);
                   12636:     my @ids=&Apache::lonnet::current_machine_ids();
                   12637:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  12638:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  12639:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12640:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12641:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   12642:         $pathtocheck = "$dir_root/$destination";
                   12643:         $dir = $dir_root;
                   12644:         $ishome = 1;
                   12645:     } else {
                   12646:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   12647:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   12648:         $dir = "$dir_root/$docudom/$docuname";    
                   12649:     }
                   12650:     my $currdir = "$dir_root/$destination";
                   12651:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   12652:     if ($env{'form.folderpath'}) {
                   12653:         my @items = split('&',$env{'form.folderpath'});
                   12654:         $folders{'0'} = $items[-2];
1.1099    raeburn  12655:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   12656:             $containers{'0'}='page';
                   12657:         } else {  
                   12658:             $containers{'0'}='sequence';
                   12659:         }
1.1055    raeburn  12660:     }
                   12661:     my @archdirs = &get_env_multiple('form.archive_directory');
                   12662:     if ($numitems) {
                   12663:         for (my $i=1; $i<=$numitems; $i++) {
                   12664:             my $path = $env{'form.archive_content_'.$i};
                   12665:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   12666:                 my $item = $1;
                   12667:                 $toplevelitems{$item} = $i;
                   12668:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   12669:                     $is_dir{$item} = 1;
                   12670:                 }
                   12671:             }
                   12672:         }
                   12673:     }
1.1067    raeburn  12674:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  12675:     if (keys(%toplevelitems) > 0) {
                   12676:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  12677:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   12678:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  12679:     }
1.1066    raeburn  12680:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  12681:     if ($numitems) {
                   12682:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  12683:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  12684:             my $path = $env{'form.archive_content_'.$i};
                   12685:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12686:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   12687:                     if ($prefix ne '' && $path ne '') {
                   12688:                         if (-e $prefix.$path) {
1.1066    raeburn  12689:                             if ((@archdirs > 0) && 
                   12690:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   12691:                                 $todeletedir{$prefix.$path} = 1;
                   12692:                             } else {
                   12693:                                 $todelete{$prefix.$path} = 1;
                   12694:                             }
1.1055    raeburn  12695:                         }
                   12696:                     }
                   12697:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  12698:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  12699:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  12700:                     $docstitle = $env{'form.archive_title_'.$i};
                   12701:                     if ($docstitle eq '') {
                   12702:                         $docstitle = $title;
                   12703:                     }
1.1055    raeburn  12704:                     $outer = 0;
1.1056    raeburn  12705:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12706:                         if (@{$dirorder{$i}} > 0) {
                   12707:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  12708:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   12709:                                     $outer = $item;
                   12710:                                     last;
                   12711:                                 }
                   12712:                             }
                   12713:                         }
                   12714:                     }
                   12715:                     my ($errtext,$fatal) = 
                   12716:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   12717:                                                '/'.$folders{$outer}.'.'.
                   12718:                                                $containers{$outer});
                   12719:                     next if ($fatal);
                   12720:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   12721:                         if ($context eq 'coursedocs') {
1.1056    raeburn  12722:                             $mapinner{$i} = time;
1.1055    raeburn  12723:                             $folders{$i} = 'default_'.$mapinner{$i};
                   12724:                             $containers{$i} = 'sequence';
                   12725:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12726:                                       $folders{$i}.'.'.$containers{$i};
                   12727:                             my $newidx = &LONCAPA::map::getresidx();
                   12728:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12729:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12730:                             push(@LONCAPA::map::order,$newidx);
                   12731:                             my ($outtext,$errtext) =
                   12732:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12733:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12734:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  12735:                             $newseqid{$i} = $newidx;
1.1067    raeburn  12736:                             unless ($errtext) {
                   12737:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   12738:                             }
1.1055    raeburn  12739:                         }
                   12740:                     } else {
                   12741:                         if ($context eq 'coursedocs') {
                   12742:                             my $newidx=&LONCAPA::map::getresidx();
                   12743:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12744:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   12745:                                       $title;
                   12746:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   12747:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   12748:                             }
                   12749:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12750:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12751:                             }
                   12752:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12753:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  12754:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  12755:                                 unless ($ishome) {
                   12756:                                     my $fetch = "$newdest{$i}/$title";
                   12757:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12758:                                     $prompttofetch{$fetch} = 1;
                   12759:                                 }
1.1055    raeburn  12760:                             }
                   12761:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12762:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12763:                             push(@LONCAPA::map::order, $newidx);
                   12764:                             my ($outtext,$errtext)=
                   12765:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12766:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12767:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  12768:                             unless ($errtext) {
                   12769:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12770:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   12771:                                 }
                   12772:                             }
1.1055    raeburn  12773:                         }
                   12774:                     }
1.1086    raeburn  12775:                 }
                   12776:             } else {
                   12777:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12778:             }
                   12779:         }
                   12780:         for (my $i=1; $i<=$numitems; $i++) {
                   12781:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12782:             my $path = $env{'form.archive_content_'.$i};
                   12783:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12784:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12785:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12786:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12787:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12788:                         my ($itemidx,$fullpath,$relpath);
                   12789:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12790:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12791:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  12792:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12793:                                     $itemidx = $j;
1.1056    raeburn  12794:                                 }
                   12795:                             }
1.1086    raeburn  12796:                         }
                   12797:                         if ($itemidx eq '') {
                   12798:                             $itemidx =  0;
                   12799:                         } 
                   12800:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12801:                             if ($mapinner{$referrer{$i}}) {
                   12802:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12803:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12804:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12805:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12806:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12807:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12808:                                             if (!-e $fullpath) {
                   12809:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12810:                                             }
                   12811:                                         }
1.1086    raeburn  12812:                                     } else {
                   12813:                                         last;
1.1056    raeburn  12814:                                     }
1.1086    raeburn  12815:                                 }
                   12816:                             }
                   12817:                         } elsif ($newdest{$referrer{$i}}) {
                   12818:                             $fullpath = $newdest{$referrer{$i}};
                   12819:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12820:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12821:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12822:                                     last;
                   12823:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12824:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12825:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12826:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12827:                                         if (!-e $fullpath) {
                   12828:                                             mkdir($fullpath,0755);
1.1056    raeburn  12829:                                         }
                   12830:                                     }
1.1086    raeburn  12831:                                 } else {
                   12832:                                     last;
1.1056    raeburn  12833:                                 }
1.1055    raeburn  12834:                             }
                   12835:                         }
1.1086    raeburn  12836:                         if ($fullpath ne '') {
                   12837:                             if (-e "$prefix$path") {
                   12838:                                 system("mv $prefix$path $fullpath/$title");
                   12839:                             }
                   12840:                             if (-e "$fullpath/$title") {
                   12841:                                 my $showpath;
                   12842:                                 if ($relpath ne '') {
                   12843:                                     $showpath = "$relpath/$title";
                   12844:                                 } else {
                   12845:                                     $showpath = "/$title";
                   12846:                                 } 
                   12847:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12848:                             } 
                   12849:                             unless ($ishome) {
                   12850:                                 my $fetch = "$fullpath/$title";
                   12851:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   12852:                                 $prompttofetch{$fetch} = 1;
                   12853:                             }
                   12854:                         }
1.1055    raeburn  12855:                     }
1.1086    raeburn  12856:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12857:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12858:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12859:                 }
                   12860:             } else {
                   12861:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12862:             }
                   12863:         }
                   12864:         if (keys(%todelete)) {
                   12865:             foreach my $key (keys(%todelete)) {
                   12866:                 unlink($key);
1.1066    raeburn  12867:             }
                   12868:         }
                   12869:         if (keys(%todeletedir)) {
                   12870:             foreach my $key (keys(%todeletedir)) {
                   12871:                 rmdir($key);
                   12872:             }
                   12873:         }
                   12874:         foreach my $dir (sort(keys(%is_dir))) {
                   12875:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12876:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12877:             }
                   12878:         }
1.1067    raeburn  12879:         if ($result ne '') {
                   12880:             $output .= '<ul>'."\n".
                   12881:                        $result."\n".
                   12882:                        '</ul>';
                   12883:         }
                   12884:         unless ($ishome) {
                   12885:             my $replicationfail;
                   12886:             foreach my $item (keys(%prompttofetch)) {
                   12887:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12888:                 unless ($fetchresult eq 'ok') {
                   12889:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12890:                 }
                   12891:             }
                   12892:             if ($replicationfail) {
                   12893:                 $output .= '<p class="LC_error">'.
                   12894:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12895:                            $replicationfail.
                   12896:                            '</ul></p>';
                   12897:             }
                   12898:         }
1.1055    raeburn  12899:     } else {
                   12900:         $warning = &mt('No items found in archive.');
                   12901:     }
                   12902:     if ($error) {
                   12903:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12904:                    $error.'</p>'."\n";
                   12905:     }
                   12906:     if ($warning) {
                   12907:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12908:     }
                   12909:     return $output;
                   12910: }
                   12911: 
1.1066    raeburn  12912: sub cleanup_empty_dirs {
                   12913:     my ($path) = @_;
                   12914:     if (($path ne '') && (-d $path)) {
                   12915:         if (opendir(my $dirh,$path)) {
                   12916:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12917:             my $numitems = 0;
                   12918:             foreach my $item (@dircontents) {
                   12919:                 if (-d "$path/$item") {
1.1111    raeburn  12920:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12921:                     if (-e "$path/$item") {
                   12922:                         $numitems ++;
                   12923:                     }
                   12924:                 } else {
                   12925:                     $numitems ++;
                   12926:                 }
                   12927:             }
                   12928:             if ($numitems == 0) {
                   12929:                 rmdir($path);
                   12930:             }
                   12931:             closedir($dirh);
                   12932:         }
                   12933:     }
                   12934:     return;
                   12935: }
                   12936: 
1.41      ng       12937: =pod
1.45      matthew  12938: 
1.1162    raeburn  12939: =item * &get_folder_hierarchy()
1.1068    raeburn  12940: 
                   12941: Provides hierarchy of names of folders/sub-folders containing the current
                   12942: item,
                   12943: 
                   12944: Inputs: 3
                   12945:      - $navmap - navmaps object
                   12946: 
                   12947:      - $map - url for map (either the trigger itself, or map containing
                   12948:                            the resource, which is the trigger).
                   12949: 
                   12950:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12951: 
                   12952: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12953: 
                   12954: =cut
                   12955: 
                   12956: sub get_folder_hierarchy {
                   12957:     my ($navmap,$map,$showitem) = @_;
                   12958:     my @pathitems;
                   12959:     if (ref($navmap)) {
                   12960:         my $mapres = $navmap->getResourceByUrl($map);
                   12961:         if (ref($mapres)) {
                   12962:             my $pcslist = $mapres->map_hierarchy();
                   12963:             if ($pcslist ne '') {
                   12964:                 my @pcs = split(/,/,$pcslist);
                   12965:                 foreach my $pc (@pcs) {
                   12966:                     if ($pc == 1) {
1.1129    raeburn  12967:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12968:                     } else {
                   12969:                         my $res = $navmap->getByMapPc($pc);
                   12970:                         if (ref($res)) {
                   12971:                             my $title = $res->compTitle();
                   12972:                             $title =~ s/\W+/_/g;
                   12973:                             if ($title ne '') {
                   12974:                                 push(@pathitems,$title);
                   12975:                             }
                   12976:                         }
                   12977:                     }
                   12978:                 }
                   12979:             }
1.1071    raeburn  12980:             if ($showitem) {
                   12981:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12982:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12983:                 } else {
                   12984:                     my $maptitle = $mapres->compTitle();
                   12985:                     $maptitle =~ s/\W+/_/g;
                   12986:                     if ($maptitle ne '') {
                   12987:                         push(@pathitems,$maptitle);
                   12988:                     }
1.1068    raeburn  12989:                 }
                   12990:             }
                   12991:         }
                   12992:     }
                   12993:     return @pathitems;
                   12994: }
                   12995: 
                   12996: =pod
                   12997: 
1.1015    raeburn  12998: =item * &get_turnedin_filepath()
                   12999: 
                   13000: Determines path in a user's portfolio file for storage of files uploaded
                   13001: to a specific essayresponse or dropbox item.
                   13002: 
                   13003: Inputs: 3 required + 1 optional.
                   13004: $symb is symb for resource, $uname and $udom are for current user (required).
                   13005: $caller is optional (can be "submission", if routine is called when storing
                   13006: an upoaded file when "Submit Answer" button was pressed).
                   13007: 
                   13008: Returns array containing $path and $multiresp. 
                   13009: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   13010: than one file upload item.  Callers of routine should append partid as a 
                   13011: subdirectory to $path in cases where $multiresp is 1.
                   13012: 
                   13013: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   13014: 
                   13015: =cut
                   13016: 
                   13017: sub get_turnedin_filepath {
                   13018:     my ($symb,$uname,$udom,$caller) = @_;
                   13019:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   13020:     my $turnindir;
                   13021:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   13022:     $turnindir = $userhash{'turnindir'};
                   13023:     my ($path,$multiresp);
                   13024:     if ($turnindir eq '') {
                   13025:         if ($caller eq 'submission') {
                   13026:             $turnindir = &mt('turned in');
                   13027:             $turnindir =~ s/\W+/_/g;
                   13028:             my %newhash = (
                   13029:                             'turnindir' => $turnindir,
                   13030:                           );
                   13031:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   13032:         }
                   13033:     }
                   13034:     if ($turnindir ne '') {
                   13035:         $path = '/'.$turnindir.'/';
                   13036:         my ($multipart,$turnin,@pathitems);
                   13037:         my $navmap = Apache::lonnavmaps::navmap->new();
                   13038:         if (defined($navmap)) {
                   13039:             my $mapres = $navmap->getResourceByUrl($map);
                   13040:             if (ref($mapres)) {
                   13041:                 my $pcslist = $mapres->map_hierarchy();
                   13042:                 if ($pcslist ne '') {
                   13043:                     foreach my $pc (split(/,/,$pcslist)) {
                   13044:                         my $res = $navmap->getByMapPc($pc);
                   13045:                         if (ref($res)) {
                   13046:                             my $title = $res->compTitle();
                   13047:                             $title =~ s/\W+/_/g;
                   13048:                             if ($title ne '') {
1.1149    raeburn  13049:                                 if (($pc > 1) && (length($title) > 12)) {
                   13050:                                     $title = substr($title,0,12);
                   13051:                                 }
1.1015    raeburn  13052:                                 push(@pathitems,$title);
                   13053:                             }
                   13054:                         }
                   13055:                     }
                   13056:                 }
                   13057:                 my $maptitle = $mapres->compTitle();
                   13058:                 $maptitle =~ s/\W+/_/g;
                   13059:                 if ($maptitle ne '') {
1.1149    raeburn  13060:                     if (length($maptitle) > 12) {
                   13061:                         $maptitle = substr($maptitle,0,12);
                   13062:                     }
1.1015    raeburn  13063:                     push(@pathitems,$maptitle);
                   13064:                 }
                   13065:                 unless ($env{'request.state'} eq 'construct') {
                   13066:                     my $res = $navmap->getBySymb($symb);
                   13067:                     if (ref($res)) {
                   13068:                         my $partlist = $res->parts();
                   13069:                         my $totaluploads = 0;
                   13070:                         if (ref($partlist) eq 'ARRAY') {
                   13071:                             foreach my $part (@{$partlist}) {
                   13072:                                 my @types = $res->responseType($part);
                   13073:                                 my @ids = $res->responseIds($part);
                   13074:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   13075:                                     if ($types[$i] eq 'essay') {
                   13076:                                         my $partid = $part.'_'.$ids[$i];
                   13077:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   13078:                                             $totaluploads ++;
                   13079:                                         }
                   13080:                                     }
                   13081:                                 }
                   13082:                             }
                   13083:                             if ($totaluploads > 1) {
                   13084:                                 $multiresp = 1;
                   13085:                             }
                   13086:                         }
                   13087:                     }
                   13088:                 }
                   13089:             } else {
                   13090:                 return;
                   13091:             }
                   13092:         } else {
                   13093:             return;
                   13094:         }
                   13095:         my $restitle=&Apache::lonnet::gettitle($symb);
                   13096:         $restitle =~ s/\W+/_/g;
                   13097:         if ($restitle eq '') {
                   13098:             $restitle = ($resurl =~ m{/[^/]+$});
                   13099:             if ($restitle eq '') {
                   13100:                 $restitle = time;
                   13101:             }
                   13102:         }
1.1149    raeburn  13103:         if (length($restitle) > 12) {
                   13104:             $restitle = substr($restitle,0,12);
                   13105:         }
1.1015    raeburn  13106:         push(@pathitems,$restitle);
                   13107:         $path .= join('/',@pathitems);
                   13108:     }
                   13109:     return ($path,$multiresp);
                   13110: }
                   13111: 
                   13112: =pod
                   13113: 
1.464     albertel 13114: =back
1.41      ng       13115: 
1.112     bowersj2 13116: =head1 CSV Upload/Handling functions
1.38      albertel 13117: 
1.41      ng       13118: =over 4
                   13119: 
1.648     raeburn  13120: =item * &upfile_store($r)
1.41      ng       13121: 
                   13122: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 13123: needs $env{'form.upfile'}
1.41      ng       13124: returns $datatoken to be put into hidden field
                   13125: 
                   13126: =cut
1.31      albertel 13127: 
                   13128: sub upfile_store {
                   13129:     my $r=shift;
1.258     albertel 13130:     $env{'form.upfile'}=~s/\r/\n/gs;
                   13131:     $env{'form.upfile'}=~s/\f/\n/gs;
                   13132:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   13133:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 13134: 
1.258     albertel 13135:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   13136: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 13137:     {
1.158     raeburn  13138:         my $datafile = $r->dir_config('lonDaemons').
                   13139:                            '/tmp/'.$datatoken.'.tmp';
                   13140:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 13141:             print $fh $env{'form.upfile'};
1.158     raeburn  13142:             close($fh);
                   13143:         }
1.31      albertel 13144:     }
                   13145:     return $datatoken;
                   13146: }
                   13147: 
1.56      matthew  13148: =pod
                   13149: 
1.648     raeburn  13150: =item * &load_tmp_file($r)
1.41      ng       13151: 
                   13152: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 13153: needs $env{'form.datatoken'},
                   13154: sets $env{'form.upfile'} to the contents of the file
1.41      ng       13155: 
                   13156: =cut
1.31      albertel 13157: 
                   13158: sub load_tmp_file {
                   13159:     my $r=shift;
                   13160:     my @studentdata=();
                   13161:     {
1.158     raeburn  13162:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 13163:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  13164:         if ( open(my $fh,"<$studentfile") ) {
                   13165:             @studentdata=<$fh>;
                   13166:             close($fh);
                   13167:         }
1.31      albertel 13168:     }
1.258     albertel 13169:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 13170: }
                   13171: 
1.56      matthew  13172: =pod
                   13173: 
1.648     raeburn  13174: =item * &upfile_record_sep()
1.41      ng       13175: 
                   13176: Separate uploaded file into records
                   13177: returns array of records,
1.258     albertel 13178: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       13179: 
                   13180: =cut
1.31      albertel 13181: 
                   13182: sub upfile_record_sep {
1.258     albertel 13183:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 13184:     } else {
1.248     albertel 13185: 	my @records;
1.258     albertel 13186: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 13187: 	    if ($line=~/^\s*$/) { next; }
                   13188: 	    push(@records,$line);
                   13189: 	}
                   13190: 	return @records;
1.31      albertel 13191:     }
                   13192: }
                   13193: 
1.56      matthew  13194: =pod
                   13195: 
1.648     raeburn  13196: =item * &record_sep($record)
1.41      ng       13197: 
1.258     albertel 13198: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       13199: 
                   13200: =cut
                   13201: 
1.263     www      13202: sub takeleft {
                   13203:     my $index=shift;
                   13204:     return substr('0000'.$index,-4,4);
                   13205: }
                   13206: 
1.31      albertel 13207: sub record_sep {
                   13208:     my $record=shift;
                   13209:     my %components=();
1.258     albertel 13210:     if ($env{'form.upfiletype'} eq 'xml') {
                   13211:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 13212:         my $i=0;
1.356     albertel 13213:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 13214:             $field=~s/^(\"|\')//;
                   13215:             $field=~s/(\"|\')$//;
1.263     www      13216:             $components{&takeleft($i)}=$field;
1.31      albertel 13217:             $i++;
                   13218:         }
1.258     albertel 13219:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 13220:         my $i=0;
1.356     albertel 13221:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 13222:             $field=~s/^(\"|\')//;
                   13223:             $field=~s/(\"|\')$//;
1.263     www      13224:             $components{&takeleft($i)}=$field;
1.31      albertel 13225:             $i++;
                   13226:         }
                   13227:     } else {
1.561     www      13228:         my $separator=',';
1.480     banghart 13229:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      13230:             $separator=';';
1.480     banghart 13231:         }
1.31      albertel 13232:         my $i=0;
1.561     www      13233: # the character we are looking for to indicate the end of a quote or a record 
                   13234:         my $looking_for=$separator;
                   13235: # do not add the characters to the fields
                   13236:         my $ignore=0;
                   13237: # we just encountered a separator (or the beginning of the record)
                   13238:         my $just_found_separator=1;
                   13239: # store the field we are working on here
                   13240:         my $field='';
                   13241: # work our way through all characters in record
                   13242:         foreach my $character ($record=~/(.)/g) {
                   13243:             if ($character eq $looking_for) {
                   13244:                if ($character ne $separator) {
                   13245: # Found the end of a quote, again looking for separator
                   13246:                   $looking_for=$separator;
                   13247:                   $ignore=1;
                   13248:                } else {
                   13249: # Found a separator, store away what we got
                   13250:                   $components{&takeleft($i)}=$field;
                   13251: 	          $i++;
                   13252:                   $just_found_separator=1;
                   13253:                   $ignore=0;
                   13254:                   $field='';
                   13255:                }
                   13256:                next;
                   13257:             }
                   13258: # single or double quotation marks after a separator indicate beginning of a quote
                   13259: # we are now looking for the end of the quote and need to ignore separators
                   13260:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   13261:                $looking_for=$character;
                   13262:                next;
                   13263:             }
                   13264: # ignore would be true after we reached the end of a quote
                   13265:             if ($ignore) { next; }
                   13266:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   13267:             $field.=$character;
                   13268:             $just_found_separator=0; 
1.31      albertel 13269:         }
1.561     www      13270: # catch the very last entry, since we never encountered the separator
                   13271:         $components{&takeleft($i)}=$field;
1.31      albertel 13272:     }
                   13273:     return %components;
                   13274: }
                   13275: 
1.144     matthew  13276: ######################################################
                   13277: ######################################################
                   13278: 
1.56      matthew  13279: =pod
                   13280: 
1.648     raeburn  13281: =item * &upfile_select_html()
1.41      ng       13282: 
1.144     matthew  13283: Return HTML code to select a file from the users machine and specify 
                   13284: the file type.
1.41      ng       13285: 
                   13286: =cut
                   13287: 
1.144     matthew  13288: ######################################################
                   13289: ######################################################
1.31      albertel 13290: sub upfile_select_html {
1.144     matthew  13291:     my %Types = (
                   13292:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 13293:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  13294:                  space => &mt('Space separated'),
                   13295:                  tab   => &mt('Tabulator separated'),
                   13296: #                 xml   => &mt('HTML/XML'),
                   13297:                  );
                   13298:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  13299:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  13300:     foreach my $type (sort(keys(%Types))) {
                   13301:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   13302:     }
                   13303:     $Str .= "</select>\n";
                   13304:     return $Str;
1.31      albertel 13305: }
                   13306: 
1.301     albertel 13307: sub get_samples {
                   13308:     my ($records,$toget) = @_;
                   13309:     my @samples=({});
                   13310:     my $got=0;
                   13311:     foreach my $rec (@$records) {
                   13312: 	my %temp = &record_sep($rec);
                   13313: 	if (! grep(/\S/, values(%temp))) { next; }
                   13314: 	if (%temp) {
                   13315: 	    $samples[$got]=\%temp;
                   13316: 	    $got++;
                   13317: 	    if ($got == $toget) { last; }
                   13318: 	}
                   13319:     }
                   13320:     return \@samples;
                   13321: }
                   13322: 
1.144     matthew  13323: ######################################################
                   13324: ######################################################
                   13325: 
1.56      matthew  13326: =pod
                   13327: 
1.648     raeburn  13328: =item * &csv_print_samples($r,$records)
1.41      ng       13329: 
                   13330: Prints a table of sample values from each column uploaded $r is an
                   13331: Apache Request ref, $records is an arrayref from
                   13332: &Apache::loncommon::upfile_record_sep
                   13333: 
                   13334: =cut
                   13335: 
1.144     matthew  13336: ######################################################
                   13337: ######################################################
1.31      albertel 13338: sub csv_print_samples {
                   13339:     my ($r,$records) = @_;
1.662     bisitz   13340:     my $samples = &get_samples($records,5);
1.301     albertel 13341: 
1.594     raeburn  13342:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   13343:               &start_data_table_header_row());
1.356     albertel 13344:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   13345:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  13346:     $r->print(&end_data_table_header_row());
1.301     albertel 13347:     foreach my $hash (@$samples) {
1.594     raeburn  13348: 	$r->print(&start_data_table_row());
1.356     albertel 13349: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 13350: 	    $r->print('<td>');
1.356     albertel 13351: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 13352: 	    $r->print('</td>');
                   13353: 	}
1.594     raeburn  13354: 	$r->print(&end_data_table_row());
1.31      albertel 13355:     }
1.594     raeburn  13356:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 13357: }
                   13358: 
1.144     matthew  13359: ######################################################
                   13360: ######################################################
                   13361: 
1.56      matthew  13362: =pod
                   13363: 
1.648     raeburn  13364: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       13365: 
                   13366: Prints a table to create associations between values and table columns.
1.144     matthew  13367: 
1.41      ng       13368: $r is an Apache Request ref,
                   13369: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  13370: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       13371: 
                   13372: =cut
                   13373: 
1.144     matthew  13374: ######################################################
                   13375: ######################################################
1.31      albertel 13376: sub csv_print_select_table {
                   13377:     my ($r,$records,$d) = @_;
1.301     albertel 13378:     my $i=0;
                   13379:     my $samples = &get_samples($records,1);
1.144     matthew  13380:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  13381: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  13382:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  13383:               '<th>'.&mt('Column').'</th>'.
                   13384:               &end_data_table_header_row()."\n");
1.356     albertel 13385:     foreach my $array_ref (@$d) {
                   13386: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  13387: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 13388: 
1.875     bisitz   13389: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  13390: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 13391: 	$r->print('<option value="none"></option>');
1.356     albertel 13392: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   13393: 	    $r->print('<option value="'.$sample.'"'.
                   13394:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   13395:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 13396: 	}
1.594     raeburn  13397: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 13398: 	$i++;
                   13399:     }
1.594     raeburn  13400:     $r->print(&end_data_table());
1.31      albertel 13401:     $i--;
                   13402:     return $i;
                   13403: }
1.56      matthew  13404: 
1.144     matthew  13405: ######################################################
                   13406: ######################################################
                   13407: 
1.56      matthew  13408: =pod
1.31      albertel 13409: 
1.648     raeburn  13410: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       13411: 
                   13412: Prints a table of sample values from the upload and can make associate samples to internal names.
                   13413: 
                   13414: $r is an Apache Request ref,
                   13415: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   13416: $d is an array of 2 element arrays (internal name, displayed name)
                   13417: 
                   13418: =cut
                   13419: 
1.144     matthew  13420: ######################################################
                   13421: ######################################################
1.31      albertel 13422: sub csv_samples_select_table {
                   13423:     my ($r,$records,$d) = @_;
                   13424:     my $i=0;
1.144     matthew  13425:     #
1.662     bisitz   13426:     my $max_samples = 5;
                   13427:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  13428:     $r->print(&start_data_table().
                   13429:               &start_data_table_header_row().'<th>'.
                   13430:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   13431:               &end_data_table_header_row());
1.301     albertel 13432: 
                   13433:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  13434: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  13435: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 13436: 	foreach my $option (@$d) {
                   13437: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  13438: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 13439:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  13440:                       $display.'</option>');
1.31      albertel 13441: 	}
                   13442: 	$r->print('</select></td><td>');
1.662     bisitz   13443: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 13444: 	    if (defined($samples->[$line]{$key})) { 
                   13445: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   13446: 	    }
                   13447: 	}
1.594     raeburn  13448: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 13449: 	$i++;
                   13450:     }
1.594     raeburn  13451:     $r->print(&end_data_table());
1.31      albertel 13452:     $i--;
                   13453:     return($i);
1.115     matthew  13454: }
                   13455: 
1.144     matthew  13456: ######################################################
                   13457: ######################################################
                   13458: 
1.115     matthew  13459: =pod
                   13460: 
1.648     raeburn  13461: =item * &clean_excel_name($name)
1.115     matthew  13462: 
                   13463: Returns a replacement for $name which does not contain any illegal characters.
                   13464: 
                   13465: =cut
                   13466: 
1.144     matthew  13467: ######################################################
                   13468: ######################################################
1.115     matthew  13469: sub clean_excel_name {
                   13470:     my ($name) = @_;
                   13471:     $name =~ s/[:\*\?\/\\]//g;
                   13472:     if (length($name) > 31) {
                   13473:         $name = substr($name,0,31);
                   13474:     }
                   13475:     return $name;
1.25      albertel 13476: }
1.84      albertel 13477: 
1.85      albertel 13478: =pod
                   13479: 
1.648     raeburn  13480: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 13481: 
                   13482: Returns either 1 or undef
                   13483: 
                   13484: 1 if the part is to be hidden, undef if it is to be shown
                   13485: 
                   13486: Arguments are:
                   13487: 
                   13488: $id the id of the part to be checked
                   13489: $symb, optional the symb of the resource to check
                   13490: $udom, optional the domain of the user to check for
                   13491: $uname, optional the username of the user to check for
                   13492: 
                   13493: =cut
1.84      albertel 13494: 
                   13495: sub check_if_partid_hidden {
                   13496:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 13497:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 13498: 					 $symb,$udom,$uname);
1.141     albertel 13499:     my $truth=1;
                   13500:     #if the string starts with !, then the list is the list to show not hide
                   13501:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 13502:     my @hiddenlist=split(/,/,$hiddenparts);
                   13503:     foreach my $checkid (@hiddenlist) {
1.141     albertel 13504: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 13505:     }
1.141     albertel 13506:     return !$truth;
1.84      albertel 13507: }
1.127     matthew  13508: 
1.138     matthew  13509: 
                   13510: ############################################################
                   13511: ############################################################
                   13512: 
                   13513: =pod
                   13514: 
1.157     matthew  13515: =back 
                   13516: 
1.138     matthew  13517: =head1 cgi-bin script and graphing routines
                   13518: 
1.157     matthew  13519: =over 4
                   13520: 
1.648     raeburn  13521: =item * &get_cgi_id()
1.138     matthew  13522: 
                   13523: Inputs: none
                   13524: 
                   13525: Returns an id which can be used to pass environment variables
                   13526: to various cgi-bin scripts.  These environment variables will
                   13527: be removed from the users environment after a given time by
                   13528: the routine &Apache::lonnet::transfer_profile_to_env.
                   13529: 
                   13530: =cut
                   13531: 
                   13532: ############################################################
                   13533: ############################################################
1.152     albertel 13534: my $uniq=0;
1.136     matthew  13535: sub get_cgi_id {
1.154     albertel 13536:     $uniq=($uniq+1)%100000;
1.280     albertel 13537:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  13538: }
                   13539: 
1.127     matthew  13540: ############################################################
                   13541: ############################################################
                   13542: 
                   13543: =pod
                   13544: 
1.648     raeburn  13545: =item * &DrawBarGraph()
1.127     matthew  13546: 
1.138     matthew  13547: Facilitates the plotting of data in a (stacked) bar graph.
                   13548: Puts plot definition data into the users environment in order for 
                   13549: graph.png to plot it.  Returns an <img> tag for the plot.
                   13550: The bars on the plot are labeled '1','2',...,'n'.
                   13551: 
                   13552: Inputs:
                   13553: 
                   13554: =over 4
                   13555: 
                   13556: =item $Title: string, the title of the plot
                   13557: 
                   13558: =item $xlabel: string, text describing the X-axis of the plot
                   13559: 
                   13560: =item $ylabel: string, text describing the Y-axis of the plot
                   13561: 
                   13562: =item $Max: scalar, the maximum Y value to use in the plot
                   13563: If $Max is < any data point, the graph will not be rendered.
                   13564: 
1.140     matthew  13565: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  13566: they are plotted.  If undefined, default values will be used.
                   13567: 
1.178     matthew  13568: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   13569: 
1.138     matthew  13570: =item @Values: An array of array references.  Each array reference holds data
                   13571: to be plotted in a stacked bar chart.
                   13572: 
1.239     matthew  13573: =item If the final element of @Values is a hash reference the key/value
                   13574: pairs will be added to the graph definition.
                   13575: 
1.138     matthew  13576: =back
                   13577: 
                   13578: Returns:
                   13579: 
                   13580: An <img> tag which references graph.png and the appropriate identifying
                   13581: information for the plot.
                   13582: 
1.127     matthew  13583: =cut
                   13584: 
                   13585: ############################################################
                   13586: ############################################################
1.134     matthew  13587: sub DrawBarGraph {
1.178     matthew  13588:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  13589:     #
                   13590:     if (! defined($colors)) {
                   13591:         $colors = ['#33ff00', 
                   13592:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   13593:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   13594:                   ]; 
                   13595:     }
1.228     matthew  13596:     my $extra_settings = {};
                   13597:     if (ref($Values[-1]) eq 'HASH') {
                   13598:         $extra_settings = pop(@Values);
                   13599:     }
1.127     matthew  13600:     #
1.136     matthew  13601:     my $identifier = &get_cgi_id();
                   13602:     my $id = 'cgi.'.$identifier;        
1.129     matthew  13603:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  13604:         return '';
                   13605:     }
1.225     matthew  13606:     #
                   13607:     my @Labels;
                   13608:     if (defined($labels)) {
                   13609:         @Labels = @$labels;
                   13610:     } else {
                   13611:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   13612:             push (@Labels,$i+1);
                   13613:         }
                   13614:     }
                   13615:     #
1.129     matthew  13616:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  13617:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  13618:     my %ValuesHash;
                   13619:     my $NumSets=1;
                   13620:     foreach my $array (@Values) {
                   13621:         next if (! ref($array));
1.136     matthew  13622:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  13623:             join(',',@$array);
1.129     matthew  13624:     }
1.127     matthew  13625:     #
1.136     matthew  13626:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  13627:     if ($NumBars < 3) {
                   13628:         $width = 120+$NumBars*32;
1.220     matthew  13629:         $xskip = 1;
1.225     matthew  13630:         $bar_width = 30;
                   13631:     } elsif ($NumBars < 5) {
                   13632:         $width = 120+$NumBars*20;
                   13633:         $xskip = 1;
                   13634:         $bar_width = 20;
1.220     matthew  13635:     } elsif ($NumBars < 10) {
1.136     matthew  13636:         $width = 120+$NumBars*15;
                   13637:         $xskip = 1;
                   13638:         $bar_width = 15;
                   13639:     } elsif ($NumBars <= 25) {
                   13640:         $width = 120+$NumBars*11;
                   13641:         $xskip = 5;
                   13642:         $bar_width = 8;
                   13643:     } elsif ($NumBars <= 50) {
                   13644:         $width = 120+$NumBars*8;
                   13645:         $xskip = 5;
                   13646:         $bar_width = 4;
                   13647:     } else {
                   13648:         $width = 120+$NumBars*8;
                   13649:         $xskip = 5;
                   13650:         $bar_width = 4;
                   13651:     }
                   13652:     #
1.137     matthew  13653:     $Max = 1 if ($Max < 1);
                   13654:     if ( int($Max) < $Max ) {
                   13655:         $Max++;
                   13656:         $Max = int($Max);
                   13657:     }
1.127     matthew  13658:     $Title  = '' if (! defined($Title));
                   13659:     $xlabel = '' if (! defined($xlabel));
                   13660:     $ylabel = '' if (! defined($ylabel));
1.369     www      13661:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   13662:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   13663:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  13664:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  13665:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   13666:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   13667:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   13668:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13669:     $ValuesHash{$id.'.height'}   = $height;
                   13670:     $ValuesHash{$id.'.width'}    = $width;
                   13671:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   13672:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   13673:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  13674:     #
1.228     matthew  13675:     # Deal with other parameters
                   13676:     while (my ($key,$value) = each(%$extra_settings)) {
                   13677:         $ValuesHash{$id.'.'.$key} = $value;
                   13678:     }
                   13679:     #
1.646     raeburn  13680:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  13681:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13682: }
                   13683: 
                   13684: ############################################################
                   13685: ############################################################
                   13686: 
                   13687: =pod
                   13688: 
1.648     raeburn  13689: =item * &DrawXYGraph()
1.137     matthew  13690: 
1.138     matthew  13691: Facilitates the plotting of data in an XY graph.
                   13692: Puts plot definition data into the users environment in order for 
                   13693: graph.png to plot it.  Returns an <img> tag for the plot.
                   13694: 
                   13695: Inputs:
                   13696: 
                   13697: =over 4
                   13698: 
                   13699: =item $Title: string, the title of the plot
                   13700: 
                   13701: =item $xlabel: string, text describing the X-axis of the plot
                   13702: 
                   13703: =item $ylabel: string, text describing the Y-axis of the plot
                   13704: 
                   13705: =item $Max: scalar, the maximum Y value to use in the plot
                   13706: If $Max is < any data point, the graph will not be rendered.
                   13707: 
                   13708: =item $colors: Array ref containing the hex color codes for the data to be 
                   13709: plotted in.  If undefined, default values will be used.
                   13710: 
                   13711: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13712: 
                   13713: =item $Ydata: Array ref containing Array refs.  
1.185     www      13714: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  13715: 
                   13716: =item %Values: hash indicating or overriding any default values which are 
                   13717: passed to graph.png.  
                   13718: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13719: 
                   13720: =back
                   13721: 
                   13722: Returns:
                   13723: 
                   13724: An <img> tag which references graph.png and the appropriate identifying
                   13725: information for the plot.
                   13726: 
1.137     matthew  13727: =cut
                   13728: 
                   13729: ############################################################
                   13730: ############################################################
                   13731: sub DrawXYGraph {
                   13732:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   13733:     #
                   13734:     # Create the identifier for the graph
                   13735:     my $identifier = &get_cgi_id();
                   13736:     my $id = 'cgi.'.$identifier;
                   13737:     #
                   13738:     $Title  = '' if (! defined($Title));
                   13739:     $xlabel = '' if (! defined($xlabel));
                   13740:     $ylabel = '' if (! defined($ylabel));
                   13741:     my %ValuesHash = 
                   13742:         (
1.369     www      13743:          $id.'.title'  => &escape($Title),
                   13744:          $id.'.xlabel' => &escape($xlabel),
                   13745:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  13746:          $id.'.y_max_value'=> $Max,
                   13747:          $id.'.labels'     => join(',',@$Xlabels),
                   13748:          $id.'.PlotType'   => 'XY',
                   13749:          );
                   13750:     #
                   13751:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13752:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13753:     }
                   13754:     #
                   13755:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13756:         return '';
                   13757:     }
                   13758:     my $NumSets=1;
1.138     matthew  13759:     foreach my $array (@{$Ydata}){
1.137     matthew  13760:         next if (! ref($array));
                   13761:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13762:     }
1.138     matthew  13763:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13764:     #
                   13765:     # Deal with other parameters
                   13766:     while (my ($key,$value) = each(%Values)) {
                   13767:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13768:     }
                   13769:     #
1.646     raeburn  13770:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13771:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13772: }
                   13773: 
                   13774: ############################################################
                   13775: ############################################################
                   13776: 
                   13777: =pod
                   13778: 
1.648     raeburn  13779: =item * &DrawXYYGraph()
1.138     matthew  13780: 
                   13781: Facilitates the plotting of data in an XY graph with two Y axes.
                   13782: Puts plot definition data into the users environment in order for 
                   13783: graph.png to plot it.  Returns an <img> tag for the plot.
                   13784: 
                   13785: Inputs:
                   13786: 
                   13787: =over 4
                   13788: 
                   13789: =item $Title: string, the title of the plot
                   13790: 
                   13791: =item $xlabel: string, text describing the X-axis of the plot
                   13792: 
                   13793: =item $ylabel: string, text describing the Y-axis of the plot
                   13794: 
                   13795: =item $colors: Array ref containing the hex color codes for the data to be 
                   13796: plotted in.  If undefined, default values will be used.
                   13797: 
                   13798: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13799: 
                   13800: =item $Ydata1: The first data set
                   13801: 
                   13802: =item $Min1: The minimum value of the left Y-axis
                   13803: 
                   13804: =item $Max1: The maximum value of the left Y-axis
                   13805: 
                   13806: =item $Ydata2: The second data set
                   13807: 
                   13808: =item $Min2: The minimum value of the right Y-axis
                   13809: 
                   13810: =item $Max2: The maximum value of the left Y-axis
                   13811: 
                   13812: =item %Values: hash indicating or overriding any default values which are 
                   13813: passed to graph.png.  
                   13814: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13815: 
                   13816: =back
                   13817: 
                   13818: Returns:
                   13819: 
                   13820: An <img> tag which references graph.png and the appropriate identifying
                   13821: information for the plot.
1.136     matthew  13822: 
                   13823: =cut
                   13824: 
                   13825: ############################################################
                   13826: ############################################################
1.137     matthew  13827: sub DrawXYYGraph {
                   13828:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13829:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13830:     #
                   13831:     # Create the identifier for the graph
                   13832:     my $identifier = &get_cgi_id();
                   13833:     my $id = 'cgi.'.$identifier;
                   13834:     #
                   13835:     $Title  = '' if (! defined($Title));
                   13836:     $xlabel = '' if (! defined($xlabel));
                   13837:     $ylabel = '' if (! defined($ylabel));
                   13838:     my %ValuesHash = 
                   13839:         (
1.369     www      13840:          $id.'.title'  => &escape($Title),
                   13841:          $id.'.xlabel' => &escape($xlabel),
                   13842:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13843:          $id.'.labels' => join(',',@$Xlabels),
                   13844:          $id.'.PlotType' => 'XY',
                   13845:          $id.'.NumSets' => 2,
1.137     matthew  13846:          $id.'.two_axes' => 1,
                   13847:          $id.'.y1_max_value' => $Max1,
                   13848:          $id.'.y1_min_value' => $Min1,
                   13849:          $id.'.y2_max_value' => $Max2,
                   13850:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13851:          );
                   13852:     #
1.137     matthew  13853:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13854:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13855:     }
                   13856:     #
                   13857:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13858:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13859:         return '';
                   13860:     }
                   13861:     my $NumSets=1;
1.137     matthew  13862:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13863:         next if (! ref($array));
                   13864:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13865:     }
                   13866:     #
                   13867:     # Deal with other parameters
                   13868:     while (my ($key,$value) = each(%Values)) {
                   13869:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13870:     }
                   13871:     #
1.646     raeburn  13872:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13873:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13874: }
                   13875: 
                   13876: ############################################################
                   13877: ############################################################
                   13878: 
                   13879: =pod
                   13880: 
1.157     matthew  13881: =back 
                   13882: 
1.139     matthew  13883: =head1 Statistics helper routines?  
                   13884: 
                   13885: Bad place for them but what the hell.
                   13886: 
1.157     matthew  13887: =over 4
                   13888: 
1.648     raeburn  13889: =item * &chartlink()
1.139     matthew  13890: 
                   13891: Returns a link to the chart for a specific student.  
                   13892: 
                   13893: Inputs:
                   13894: 
                   13895: =over 4
                   13896: 
                   13897: =item $linktext: The text of the link
                   13898: 
                   13899: =item $sname: The students username
                   13900: 
                   13901: =item $sdomain: The students domain
                   13902: 
                   13903: =back
                   13904: 
1.157     matthew  13905: =back
                   13906: 
1.139     matthew  13907: =cut
                   13908: 
                   13909: ############################################################
                   13910: ############################################################
                   13911: sub chartlink {
                   13912:     my ($linktext, $sname, $sdomain) = @_;
                   13913:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13914:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13915:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13916:        '">'.$linktext.'</a>';
1.153     matthew  13917: }
                   13918: 
                   13919: #######################################################
                   13920: #######################################################
                   13921: 
                   13922: =pod
                   13923: 
                   13924: =head1 Course Environment Routines
1.157     matthew  13925: 
                   13926: =over 4
1.153     matthew  13927: 
1.648     raeburn  13928: =item * &restore_course_settings()
1.153     matthew  13929: 
1.648     raeburn  13930: =item * &store_course_settings()
1.153     matthew  13931: 
                   13932: Restores/Store indicated form parameters from the course environment.
                   13933: Will not overwrite existing values of the form parameters.
                   13934: 
                   13935: Inputs: 
                   13936: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13937: 
                   13938: a hash ref describing the data to be stored.  For example:
                   13939:    
                   13940: %Save_Parameters = ('Status' => 'scalar',
                   13941:     'chartoutputmode' => 'scalar',
                   13942:     'chartoutputdata' => 'scalar',
                   13943:     'Section' => 'array',
1.373     raeburn  13944:     'Group' => 'array',
1.153     matthew  13945:     'StudentData' => 'array',
                   13946:     'Maps' => 'array');
                   13947: 
                   13948: Returns: both routines return nothing
                   13949: 
1.631     raeburn  13950: =back
                   13951: 
1.153     matthew  13952: =cut
                   13953: 
                   13954: #######################################################
                   13955: #######################################################
                   13956: sub store_course_settings {
1.496     albertel 13957:     return &store_settings($env{'request.course.id'},@_);
                   13958: }
                   13959: 
                   13960: sub store_settings {
1.153     matthew  13961:     # save to the environment
                   13962:     # appenv the same items, just to be safe
1.300     albertel 13963:     my $udom  = $env{'user.domain'};
                   13964:     my $uname = $env{'user.name'};
1.496     albertel 13965:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13966:     my %SaveHash;
                   13967:     my %AppHash;
                   13968:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13969:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13970:         my $envname = 'environment.'.$basename;
1.258     albertel 13971:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13972:             # Save this value away
                   13973:             if ($type eq 'scalar' &&
1.258     albertel 13974:                 (! exists($env{$envname}) || 
                   13975:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13976:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13977:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13978:             } elsif ($type eq 'array') {
                   13979:                 my $stored_form;
1.258     albertel 13980:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13981:                     $stored_form = join(',',
                   13982:                                         map {
1.369     www      13983:                                             &escape($_);
1.258     albertel 13984:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13985:                 } else {
                   13986:                     $stored_form = 
1.369     www      13987:                         &escape($env{'form.'.$setting});
1.153     matthew  13988:                 }
                   13989:                 # Determine if the array contents are the same.
1.258     albertel 13990:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13991:                     $SaveHash{$basename} = $stored_form;
                   13992:                     $AppHash{$envname}   = $stored_form;
                   13993:                 }
                   13994:             }
                   13995:         }
                   13996:     }
                   13997:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13998:                                           $udom,$uname);
1.153     matthew  13999:     if ($put_result !~ /^(ok|delayed)/) {
                   14000:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   14001:                                  'got error:'.$put_result);
                   14002:     }
                   14003:     # Make sure these settings stick around in this session, too
1.646     raeburn  14004:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  14005:     return;
                   14006: }
                   14007: 
                   14008: sub restore_course_settings {
1.499     albertel 14009:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 14010: }
                   14011: 
                   14012: sub restore_settings {
                   14013:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14014:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 14015:         next if (exists($env{'form.'.$setting}));
1.496     albertel 14016:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  14017:             '.'.$setting;
1.258     albertel 14018:         if (exists($env{$envname})) {
1.153     matthew  14019:             if ($type eq 'scalar') {
1.258     albertel 14020:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  14021:             } elsif ($type eq 'array') {
1.258     albertel 14022:                 $env{'form.'.$setting} = [ 
1.153     matthew  14023:                                            map { 
1.369     www      14024:                                                &unescape($_); 
1.258     albertel 14025:                                            } split(',',$env{$envname})
1.153     matthew  14026:                                            ];
                   14027:             }
                   14028:         }
                   14029:     }
1.127     matthew  14030: }
                   14031: 
1.618     raeburn  14032: #######################################################
                   14033: #######################################################
                   14034: 
                   14035: =pod
                   14036: 
                   14037: =head1 Domain E-mail Routines  
                   14038: 
                   14039: =over 4
                   14040: 
1.648     raeburn  14041: =item * &build_recipient_list()
1.618     raeburn  14042: 
1.1144    raeburn  14043: Build recipient lists for following types of e-mail:
1.766     raeburn  14044: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  14045: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   14046: module change checking, student/employee ID conflict checks, as
                   14047: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   14048: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  14049: 
                   14050: Inputs:
1.619     raeburn  14051: defmail (scalar - email address of default recipient), 
1.1144    raeburn  14052: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   14053: requestsmail, updatesmail, or idconflictsmail).
                   14054: 
1.619     raeburn  14055: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  14056: 
1.619     raeburn  14057: origmail (scalar - email address of recipient from loncapa.conf, 
                   14058: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  14059: 
1.655     raeburn  14060: Returns: comma separated list of addresses to which to send e-mail.
                   14061: 
                   14062: =back
1.618     raeburn  14063: 
                   14064: =cut
                   14065: 
                   14066: ############################################################
                   14067: ############################################################
                   14068: sub build_recipient_list {
1.619     raeburn  14069:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  14070:     my @recipients;
                   14071:     my $otheremails;
                   14072:     my %domconfig =
                   14073:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   14074:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  14075:         if (exists($domconfig{'contacts'}{$mailing})) {
                   14076:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   14077:                 my @contacts = ('adminemail','supportemail');
                   14078:                 foreach my $item (@contacts) {
                   14079:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   14080:                         my $addr = $domconfig{'contacts'}{$item}; 
                   14081:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14082:                             push(@recipients,$addr);
                   14083:                         }
1.619     raeburn  14084:                     }
1.766     raeburn  14085:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  14086:                 }
                   14087:             }
1.766     raeburn  14088:         } elsif ($origmail ne '') {
                   14089:             push(@recipients,$origmail);
1.618     raeburn  14090:         }
1.619     raeburn  14091:     } elsif ($origmail ne '') {
                   14092:         push(@recipients,$origmail);
1.618     raeburn  14093:     }
1.688     raeburn  14094:     if (defined($defmail)) {
                   14095:         if ($defmail ne '') {
                   14096:             push(@recipients,$defmail);
                   14097:         }
1.618     raeburn  14098:     }
                   14099:     if ($otheremails) {
1.619     raeburn  14100:         my @others;
                   14101:         if ($otheremails =~ /,/) {
                   14102:             @others = split(/,/,$otheremails);
1.618     raeburn  14103:         } else {
1.619     raeburn  14104:             push(@others,$otheremails);
                   14105:         }
                   14106:         foreach my $addr (@others) {
                   14107:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14108:                 push(@recipients,$addr);
                   14109:             }
1.618     raeburn  14110:         }
                   14111:     }
1.619     raeburn  14112:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  14113:     return $recipientlist;
                   14114: }
                   14115: 
1.127     matthew  14116: ############################################################
                   14117: ############################################################
1.154     albertel 14118: 
1.655     raeburn  14119: =pod
                   14120: 
1.1224    musolffc 14121: =over 4
                   14122: 
1.1223    musolffc 14123: =item * &mime_email()
                   14124: 
                   14125: Sends an email with a possible attachment
                   14126: 
                   14127: Inputs:
                   14128: 
                   14129: =over 4
                   14130: 
                   14131: from -              Sender's email address
                   14132: 
                   14133: to -                Email address of recipient
                   14134: 
                   14135: subject -           Subject of email
                   14136: 
                   14137: body -              Body of email
                   14138: 
                   14139: cc_string -         Carbon copy email address
                   14140: 
                   14141: bcc -               Blind carbon copy email address
                   14142: 
                   14143: type -              File type of attachment
                   14144: 
                   14145: attachment_path -   Path of file to be attached
                   14146: 
                   14147: file_name -         Name of file to be attached
                   14148: 
                   14149: attachment_text -   The body of an attachment of type "TEXT"
                   14150: 
                   14151: =back
                   14152: 
                   14153: =back
                   14154: 
                   14155: =cut
                   14156: 
                   14157: ############################################################
                   14158: ############################################################
                   14159: 
                   14160: sub mime_email {
                   14161:     my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
                   14162:         $file_name, $attachment_text) = @_;
                   14163:     my $msg = MIME::Lite->new(
                   14164:              From    => $from,
                   14165:              To      => $to,
                   14166:              Subject => $subject,
                   14167:              Type    =>'TEXT',
                   14168:              Data    => $body,
                   14169:              );
                   14170:     if ($cc_string ne '') {
                   14171:         $msg->add("Cc" => $cc_string);
                   14172:     }
                   14173:     if ($bcc ne '') {
                   14174:         $msg->add("Bcc" => $bcc);
                   14175:     }
                   14176:     $msg->attr("content-type"         => "text/plain");
                   14177:     $msg->attr("content-type.charset" => "UTF-8");
                   14178:     # Attach file if given
                   14179:     if ($attachment_path) {
                   14180:         unless ($file_name) {
                   14181:             if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
                   14182:         }
                   14183:         my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
                   14184:         $msg->attach(Type     => $type,
                   14185:                      Path     => $attachment_path,
                   14186:                      Filename => $file_name
                   14187:                      );
                   14188:     # Otherwise attach text if given
                   14189:     } elsif ($attachment_text) {
                   14190:         $msg->attach(Type => 'TEXT',
                   14191:                      Data => $attachment_text);
                   14192:     }
                   14193:     # Send it
                   14194:     $msg->send('sendmail');
                   14195: }
                   14196: 
                   14197: ############################################################
                   14198: ############################################################
                   14199: 
                   14200: =pod
                   14201: 
1.655     raeburn  14202: =head1 Course Catalog Routines
                   14203: 
                   14204: =over 4
                   14205: 
                   14206: =item * &gather_categories()
                   14207: 
                   14208: Converts category definitions - keys of categories hash stored in  
                   14209: coursecategories in configuration.db on the primary library server in a 
                   14210: domain - to an array.  Also generates javascript and idx hash used to 
                   14211: generate Domain Coordinator interface for editing Course Categories.
                   14212: 
                   14213: Inputs:
1.663     raeburn  14214: 
1.655     raeburn  14215: categories (reference to hash of category definitions).
1.663     raeburn  14216: 
1.655     raeburn  14217: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14218:       categories and subcategories).
1.663     raeburn  14219: 
1.655     raeburn  14220: idx (reference to hash of counters used in Domain Coordinator interface for 
                   14221:       editing Course Categories).
1.663     raeburn  14222: 
1.655     raeburn  14223: jsarray (reference to array of categories used to create Javascript arrays for
                   14224:          Domain Coordinator interface for editing Course Categories).
                   14225: 
                   14226: Returns: nothing
                   14227: 
                   14228: Side effects: populates cats, idx and jsarray. 
                   14229: 
                   14230: =cut
                   14231: 
                   14232: sub gather_categories {
                   14233:     my ($categories,$cats,$idx,$jsarray) = @_;
                   14234:     my %counters;
                   14235:     my $num = 0;
                   14236:     foreach my $item (keys(%{$categories})) {
                   14237:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   14238:         if ($container eq '' && $depth == 0) {
                   14239:             $cats->[$depth][$categories->{$item}] = $cat;
                   14240:         } else {
                   14241:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   14242:         }
                   14243:         my ($escitem,$tail) = split(/:/,$item,2);
                   14244:         if ($counters{$tail} eq '') {
                   14245:             $counters{$tail} = $num;
                   14246:             $num ++;
                   14247:         }
                   14248:         if (ref($idx) eq 'HASH') {
                   14249:             $idx->{$item} = $counters{$tail};
                   14250:         }
                   14251:         if (ref($jsarray) eq 'ARRAY') {
                   14252:             push(@{$jsarray->[$counters{$tail}]},$item);
                   14253:         }
                   14254:     }
                   14255:     return;
                   14256: }
                   14257: 
                   14258: =pod
                   14259: 
                   14260: =item * &extract_categories()
                   14261: 
                   14262: Used to generate breadcrumb trails for course categories.
                   14263: 
                   14264: Inputs:
1.663     raeburn  14265: 
1.655     raeburn  14266: categories (reference to hash of category definitions).
1.663     raeburn  14267: 
1.655     raeburn  14268: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14269:       categories and subcategories).
1.663     raeburn  14270: 
1.655     raeburn  14271: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  14272: 
1.655     raeburn  14273: allitems (reference to hash - key is category key 
                   14274:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14275: 
1.655     raeburn  14276: idx (reference to hash of counters used in Domain Coordinator interface for
                   14277:       editing Course Categories).
1.663     raeburn  14278: 
1.655     raeburn  14279: jsarray (reference to array of categories used to create Javascript arrays for
                   14280:          Domain Coordinator interface for editing Course Categories).
                   14281: 
1.665     raeburn  14282: subcats (reference to hash of arrays containing all subcategories within each 
                   14283:          category, -recursive)
                   14284: 
1.655     raeburn  14285: Returns: nothing
                   14286: 
                   14287: Side effects: populates trails and allitems hash references.
                   14288: 
                   14289: =cut
                   14290: 
                   14291: sub extract_categories {
1.665     raeburn  14292:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  14293:     if (ref($categories) eq 'HASH') {
                   14294:         &gather_categories($categories,$cats,$idx,$jsarray);
                   14295:         if (ref($cats->[0]) eq 'ARRAY') {
                   14296:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   14297:                 my $name = $cats->[0][$i];
                   14298:                 my $item = &escape($name).'::0';
                   14299:                 my $trailstr;
                   14300:                 if ($name eq 'instcode') {
                   14301:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  14302:                 } elsif ($name eq 'communities') {
                   14303:                     $trailstr = &mt('Communities');
1.1239    raeburn  14304:                 } elsif ($name eq 'placement') {
                   14305:                     $trailstr = &mt('Placement Tests');
1.655     raeburn  14306:                 } else {
                   14307:                     $trailstr = $name;
                   14308:                 }
                   14309:                 if ($allitems->{$item} eq '') {
                   14310:                     push(@{$trails},$trailstr);
                   14311:                     $allitems->{$item} = scalar(@{$trails})-1;
                   14312:                 }
                   14313:                 my @parents = ($name);
                   14314:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   14315:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   14316:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  14317:                         if (ref($subcats) eq 'HASH') {
                   14318:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   14319:                         }
                   14320:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   14321:                     }
                   14322:                 } else {
                   14323:                     if (ref($subcats) eq 'HASH') {
                   14324:                         $subcats->{$item} = [];
1.655     raeburn  14325:                     }
                   14326:                 }
                   14327:             }
                   14328:         }
                   14329:     }
                   14330:     return;
                   14331: }
                   14332: 
                   14333: =pod
                   14334: 
1.1162    raeburn  14335: =item * &recurse_categories()
1.655     raeburn  14336: 
                   14337: Recursively used to generate breadcrumb trails for course categories.
                   14338: 
                   14339: Inputs:
1.663     raeburn  14340: 
1.655     raeburn  14341: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14342:       categories and subcategories).
1.663     raeburn  14343: 
1.655     raeburn  14344: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  14345: 
                   14346: category (current course category, for which breadcrumb trail is being generated).
                   14347: 
                   14348: trails (reference to array of breadcrumb trails for each category).
                   14349: 
1.655     raeburn  14350: allitems (reference to hash - key is category key
                   14351:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14352: 
1.655     raeburn  14353: parents (array containing containers directories for current category, 
                   14354:          back to top level). 
                   14355: 
                   14356: Returns: nothing
                   14357: 
                   14358: Side effects: populates trails and allitems hash references
                   14359: 
                   14360: =cut
                   14361: 
                   14362: sub recurse_categories {
1.665     raeburn  14363:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  14364:     my $shallower = $depth - 1;
                   14365:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   14366:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   14367:             my $name = $cats->[$depth]{$category}[$k];
                   14368:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14369:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14370:             if ($allitems->{$item} eq '') {
                   14371:                 push(@{$trails},$trailstr);
                   14372:                 $allitems->{$item} = scalar(@{$trails})-1;
                   14373:             }
                   14374:             my $deeper = $depth+1;
                   14375:             push(@{$parents},$category);
1.665     raeburn  14376:             if (ref($subcats) eq 'HASH') {
                   14377:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   14378:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   14379:                     my $higher;
                   14380:                     if ($j > 0) {
                   14381:                         $higher = &escape($parents->[$j]).':'.
                   14382:                                   &escape($parents->[$j-1]).':'.$j;
                   14383:                     } else {
                   14384:                         $higher = &escape($parents->[$j]).'::'.$j;
                   14385:                     }
                   14386:                     push(@{$subcats->{$higher}},$subcat);
                   14387:                 }
                   14388:             }
                   14389:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   14390:                                 $subcats);
1.655     raeburn  14391:             pop(@{$parents});
                   14392:         }
                   14393:     } else {
                   14394:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14395:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14396:         if ($allitems->{$item} eq '') {
                   14397:             push(@{$trails},$trailstr);
                   14398:             $allitems->{$item} = scalar(@{$trails})-1;
                   14399:         }
                   14400:     }
                   14401:     return;
                   14402: }
                   14403: 
1.663     raeburn  14404: =pod
                   14405: 
1.1162    raeburn  14406: =item * &assign_categories_table()
1.663     raeburn  14407: 
                   14408: Create a datatable for display of hierarchical categories in a domain,
                   14409: with checkboxes to allow a course to be categorized. 
                   14410: 
                   14411: Inputs:
                   14412: 
                   14413: cathash - reference to hash of categories defined for the domain (from
                   14414:           configuration.db)
                   14415: 
                   14416: currcat - scalar with an & separated list of categories assigned to a course. 
                   14417: 
1.919     raeburn  14418: type    - scalar contains course type (Course or Community).
                   14419: 
1.663     raeburn  14420: Returns: $output (markup to be displayed) 
                   14421: 
                   14422: =cut
                   14423: 
                   14424: sub assign_categories_table {
1.919     raeburn  14425:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  14426:     my $output;
                   14427:     if (ref($cathash) eq 'HASH') {
                   14428:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   14429:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   14430:         $maxdepth = scalar(@cats);
                   14431:         if (@cats > 0) {
                   14432:             my $itemcount = 0;
                   14433:             if (ref($cats[0]) eq 'ARRAY') {
                   14434:                 my @currcategories;
                   14435:                 if ($currcat ne '') {
                   14436:                     @currcategories = split('&',$currcat);
                   14437:                 }
1.919     raeburn  14438:                 my $table;
1.663     raeburn  14439:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   14440:                     my $parent = $cats[0][$i];
1.919     raeburn  14441:                     next if ($parent eq 'instcode');
                   14442:                     if ($type eq 'Community') {
                   14443:                         next unless ($parent eq 'communities');
1.1239    raeburn  14444:                     } elsif ($type eq 'Placement') {
                   14445:                         next unless ($parent eq 'placement');
1.919     raeburn  14446:                     } else {
1.1239    raeburn  14447:                         next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919     raeburn  14448:                     }
1.663     raeburn  14449:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   14450:                     my $item = &escape($parent).'::0';
                   14451:                     my $checked = '';
                   14452:                     if (@currcategories > 0) {
                   14453:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   14454:                             $checked = ' checked="checked"';
1.663     raeburn  14455:                         }
                   14456:                     }
1.919     raeburn  14457:                     my $parent_title = $parent;
                   14458:                     if ($parent eq 'communities') {
                   14459:                         $parent_title = &mt('Communities');
1.1239    raeburn  14460:                     } elsif ($parent eq 'placement') {
                   14461:                         $parent_title = &mt('Placement Tests');
1.919     raeburn  14462:                     }
                   14463:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   14464:                               '<input type="checkbox" name="usecategory" value="'.
                   14465:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   14466:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  14467:                     my $depth = 1;
                   14468:                     push(@path,$parent);
1.919     raeburn  14469:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  14470:                     pop(@path);
1.919     raeburn  14471:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  14472:                     $itemcount ++;
                   14473:                 }
1.919     raeburn  14474:                 if ($itemcount) {
                   14475:                     $output = &Apache::loncommon::start_data_table().
                   14476:                               $table.
                   14477:                               &Apache::loncommon::end_data_table();
                   14478:                 }
1.663     raeburn  14479:             }
                   14480:         }
                   14481:     }
                   14482:     return $output;
                   14483: }
                   14484: 
                   14485: =pod
                   14486: 
1.1162    raeburn  14487: =item * &assign_category_rows()
1.663     raeburn  14488: 
                   14489: Create a datatable row for display of nested categories in a domain,
                   14490: with checkboxes to allow a course to be categorized,called recursively.
                   14491: 
                   14492: Inputs:
                   14493: 
                   14494: itemcount - track row number for alternating colors
                   14495: 
                   14496: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   14497:       categories and subcategories.
                   14498: 
                   14499: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   14500: 
                   14501: parent - parent of current category item
                   14502: 
                   14503: path - Array containing all categories back up through the hierarchy from the
                   14504:        current category to the top level.
                   14505: 
                   14506: currcategories - reference to array of current categories assigned to the course
                   14507: 
                   14508: Returns: $output (markup to be displayed).
                   14509: 
                   14510: =cut
                   14511: 
                   14512: sub assign_category_rows {
                   14513:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   14514:     my ($text,$name,$item,$chgstr);
                   14515:     if (ref($cats) eq 'ARRAY') {
                   14516:         my $maxdepth = scalar(@{$cats});
                   14517:         if (ref($cats->[$depth]) eq 'HASH') {
                   14518:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   14519:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   14520:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  14521:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  14522:                 for (my $j=0; $j<$numchildren; $j++) {
                   14523:                     $name = $cats->[$depth]{$parent}[$j];
                   14524:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   14525:                     my $deeper = $depth+1;
                   14526:                     my $checked = '';
                   14527:                     if (ref($currcategories) eq 'ARRAY') {
                   14528:                         if (@{$currcategories} > 0) {
                   14529:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   14530:                                 $checked = ' checked="checked"';
1.663     raeburn  14531:                             }
                   14532:                         }
                   14533:                     }
1.664     raeburn  14534:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   14535:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  14536:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   14537:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   14538:                              '</td><td>';
1.663     raeburn  14539:                     if (ref($path) eq 'ARRAY') {
                   14540:                         push(@{$path},$name);
                   14541:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   14542:                         pop(@{$path});
                   14543:                     }
                   14544:                     $text .= '</td></tr>';
                   14545:                 }
                   14546:                 $text .= '</table></td>';
                   14547:             }
                   14548:         }
                   14549:     }
                   14550:     return $text;
                   14551: }
                   14552: 
1.1181    raeburn  14553: =pod
                   14554: 
                   14555: =back
                   14556: 
                   14557: =cut
                   14558: 
1.655     raeburn  14559: ############################################################
                   14560: ############################################################
                   14561: 
                   14562: 
1.443     albertel 14563: sub commit_customrole {
1.664     raeburn  14564:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  14565:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 14566:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   14567:                          ($end?', ending '.localtime($end):'').': <b>'.
                   14568:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  14569:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 14570:                  '</b><br />';
                   14571:     return $output;
                   14572: }
                   14573: 
                   14574: sub commit_standardrole {
1.1116    raeburn  14575:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  14576:     my ($output,$logmsg,$linefeed);
                   14577:     if ($context eq 'auto') {
                   14578:         $linefeed = "\n";
                   14579:     } else {
                   14580:         $linefeed = "<br />\n";
                   14581:     }  
1.443     albertel 14582:     if ($three eq 'st') {
1.541     raeburn  14583:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  14584:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  14585:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  14586:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   14587:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 14588:         } else {
1.541     raeburn  14589:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 14590:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14591:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   14592:             if ($context eq 'auto') {
                   14593:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   14594:             } else {
                   14595:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   14596:                &mt('Add to classlist').': <b>ok</b>';
                   14597:             }
                   14598:             $output .= $linefeed;
1.443     albertel 14599:         }
                   14600:     } else {
                   14601:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   14602:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14603:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  14604:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  14605:         if ($context eq 'auto') {
                   14606:             $output .= $result.$linefeed;
                   14607:         } else {
                   14608:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   14609:         }
1.443     albertel 14610:     }
                   14611:     return $output;
                   14612: }
                   14613: 
                   14614: sub commit_studentrole {
1.1116    raeburn  14615:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   14616:         $credits) = @_;
1.626     raeburn  14617:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  14618:     if ($context eq 'auto') {
                   14619:         $linefeed = "\n";
                   14620:     } else {
                   14621:         $linefeed = '<br />'."\n";
                   14622:     }
1.443     albertel 14623:     if (defined($one) && defined($two)) {
                   14624:         my $cid=$one.'_'.$two;
                   14625:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   14626:         my $secchange = 0;
                   14627:         my $expire_role_result;
                   14628:         my $modify_section_result;
1.628     raeburn  14629:         if ($oldsec ne '-1') { 
                   14630:             if ($oldsec ne $sec) {
1.443     albertel 14631:                 $secchange = 1;
1.628     raeburn  14632:                 my $now = time;
1.443     albertel 14633:                 my $uurl='/'.$cid;
                   14634:                 $uurl=~s/\_/\//g;
                   14635:                 if ($oldsec) {
                   14636:                     $uurl.='/'.$oldsec;
                   14637:                 }
1.626     raeburn  14638:                 $oldsecurl = $uurl;
1.628     raeburn  14639:                 $expire_role_result = 
1.652     raeburn  14640:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  14641:                 if ($env{'request.course.sec'} ne '') { 
                   14642:                     if ($expire_role_result eq 'refused') {
                   14643:                         my @roles = ('st');
                   14644:                         my @statuses = ('previous');
                   14645:                         my @roledoms = ($one);
                   14646:                         my $withsec = 1;
                   14647:                         my %roleshash = 
                   14648:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   14649:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   14650:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   14651:                             my ($oldstart,$oldend) = 
                   14652:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   14653:                             if ($oldend > 0 && $oldend <= $now) {
                   14654:                                 $expire_role_result = 'ok';
                   14655:                             }
                   14656:                         }
                   14657:                     }
                   14658:                 }
1.443     albertel 14659:                 $result = $expire_role_result;
                   14660:             }
                   14661:         }
                   14662:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  14663:             $modify_section_result = 
                   14664:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   14665:                                                            undef,undef,undef,$sec,
                   14666:                                                            $end,$start,'','',$cid,
                   14667:                                                            '',$context,$credits);
1.443     albertel 14668:             if ($modify_section_result =~ /^ok/) {
                   14669:                 if ($secchange == 1) {
1.628     raeburn  14670:                     if ($sec eq '') {
                   14671:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   14672:                     } else {
                   14673:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   14674:                     }
1.443     albertel 14675:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  14676:                     if ($sec eq '') {
                   14677:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   14678:                     } else {
                   14679:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14680:                     }
1.443     albertel 14681:                 } else {
1.628     raeburn  14682:                     if ($sec eq '') {
                   14683:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   14684:                     } else {
                   14685:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14686:                     }
1.443     albertel 14687:                 }
                   14688:             } else {
1.1115    raeburn  14689:                 if ($secchange) { 
1.628     raeburn  14690:                     $$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;
                   14691:                 } else {
                   14692:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   14693:                 }
1.443     albertel 14694:             }
                   14695:             $result = $modify_section_result;
                   14696:         } elsif ($secchange == 1) {
1.628     raeburn  14697:             if ($oldsec eq '') {
1.1103    raeburn  14698:                 $$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  14699:             } else {
                   14700:                 $$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;
                   14701:             }
1.626     raeburn  14702:             if ($expire_role_result eq 'refused') {
                   14703:                 my $newsecurl = '/'.$cid;
                   14704:                 $newsecurl =~ s/\_/\//g;
                   14705:                 if ($sec ne '') {
                   14706:                     $newsecurl.='/'.$sec;
                   14707:                 }
                   14708:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   14709:                     if ($sec eq '') {
                   14710:                         $$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;
                   14711:                     } else {
                   14712:                         $$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;
                   14713:                     }
                   14714:                 }
                   14715:             }
1.443     albertel 14716:         }
                   14717:     } else {
1.626     raeburn  14718:         $$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 14719:         $result = "error: incomplete course id\n";
                   14720:     }
                   14721:     return $result;
                   14722: }
                   14723: 
1.1108    raeburn  14724: sub show_role_extent {
                   14725:     my ($scope,$context,$role) = @_;
                   14726:     $scope =~ s{^/}{};
                   14727:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   14728:     push(@courseroles,'co');
                   14729:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   14730:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   14731:         $scope =~ s{/}{_};
                   14732:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   14733:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   14734:         my ($audom,$auname) = split(/\//,$scope);
                   14735:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   14736:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   14737:     } else {
                   14738:         $scope =~ s{/$}{};
                   14739:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   14740:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   14741:     }
                   14742: }
                   14743: 
1.443     albertel 14744: ############################################################
                   14745: ############################################################
                   14746: 
1.566     albertel 14747: sub check_clone {
1.578     raeburn  14748:     my ($args,$linefeed) = @_;
1.566     albertel 14749:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   14750:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   14751:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   14752:     my $clonemsg;
                   14753:     my $can_clone = 0;
1.944     raeburn  14754:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  14755:     if ($lctype ne 'community') {
                   14756:         $lctype = 'course';
                   14757:     }
1.566     albertel 14758:     if ($clonehome eq 'no_host') {
1.944     raeburn  14759:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14760:             $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'});
                   14761:         } else {
                   14762:             $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'});
                   14763:         }     
1.566     albertel 14764:     } else {
                   14765: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  14766:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14767:             if ($clonedesc{'type'} ne 'Community') {
                   14768:                  $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'});
                   14769:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14770:             }
                   14771:         }
1.882     raeburn  14772: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   14773:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 14774: 	    $can_clone = 1;
                   14775: 	} else {
1.1221    raeburn  14776: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 14777: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1221    raeburn  14778:             if ($clonehash{'cloners'} eq '') {
                   14779:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   14780:                 if ($domdefs{'canclone'}) {
                   14781:                     unless ($domdefs{'canclone'} eq 'none') {
                   14782:                         if ($domdefs{'canclone'} eq 'domain') {
                   14783:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   14784:                                 $can_clone = 1;
                   14785:                             }
                   14786:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   14787:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   14788:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   14789:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   14790:                                 $can_clone = 1;
                   14791:                             }
                   14792:                         }
                   14793:                     }
                   14794:                 }
1.578     raeburn  14795:             } else {
1.1221    raeburn  14796: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   14797:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  14798:                     $can_clone = 1;
1.1221    raeburn  14799:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  14800:                     $can_clone = 1;
1.1225    raeburn  14801:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   14802:                     $can_clone = 1;
1.1221    raeburn  14803:                 }
                   14804:                 unless ($can_clone) {
1.1225    raeburn  14805:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   14806:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1221    raeburn  14807:                         my (%gotdomdefaults,%gotcodedefaults);
                   14808:                         foreach my $cloner (@cloners) {
                   14809:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   14810:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   14811:                                 my (%codedefaults,@code_order);
                   14812:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   14813:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   14814:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   14815:                                     }
                   14816:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   14817:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   14818:                                     }
                   14819:                                 } else {
                   14820:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   14821:                                                                             \%codedefaults,
                   14822:                                                                             \@code_order);
                   14823:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   14824:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   14825:                                 }
                   14826:                                 if (@code_order > 0) {
                   14827:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   14828:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   14829:                                                                                 $args->{'crscode'})) {
                   14830:                                         $can_clone = 1;
                   14831:                                         last;
                   14832:                                     }
                   14833:                                 }
                   14834:                             }
                   14835:                         }
                   14836:                     }
1.1225    raeburn  14837:                 }
                   14838:             }
                   14839:             unless ($can_clone) {
                   14840:                 my $ccrole = 'cc';
                   14841:                 if ($args->{'crstype'} eq 'Community') {
                   14842:                     $ccrole = 'co';
                   14843:                 }
                   14844: 	        my %roleshash =
                   14845: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   14846: 					          $args->{'ccdomain'},
                   14847:                                                   'userroles',['active'],[$ccrole],
                   14848: 					          [$args->{'clonedomain'}]);
                   14849: 	        if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   14850:                     $can_clone = 1;
                   14851:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   14852:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   14853:                     $can_clone = 1;
1.1221    raeburn  14854:                 }
                   14855:             }
                   14856:             unless ($can_clone) {
                   14857:                 if ($args->{'crstype'} eq 'Community') {
                   14858:                     $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  14859:                 } else {
1.1221    raeburn  14860:                     $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'});
                   14861:                 }
1.566     albertel 14862: 	    }
1.578     raeburn  14863:         }
1.566     albertel 14864:     }
                   14865:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14866: }
                   14867: 
1.444     albertel 14868: sub construct_course {
1.1166    raeburn  14869:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 14870:     my $outcome;
1.541     raeburn  14871:     my $linefeed =  '<br />'."\n";
                   14872:     if ($context eq 'auto') {
                   14873:         $linefeed = "\n";
                   14874:     }
1.566     albertel 14875: 
                   14876: #
                   14877: # Are we cloning?
                   14878: #
                   14879:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14880:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  14881: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 14882: 	if ($context ne 'auto') {
1.578     raeburn  14883:             if ($clonemsg ne '') {
                   14884: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   14885:             }
1.566     albertel 14886: 	}
                   14887: 	$outcome .= $clonemsg.$linefeed;
                   14888: 
                   14889:         if (!$can_clone) {
                   14890: 	    return (0,$outcome);
                   14891: 	}
                   14892:     }
                   14893: 
1.444     albertel 14894: #
                   14895: # Open course
                   14896: #
1.1239    raeburn  14897:     my $showncrstype;
                   14898:     if ($args->{'crstype'} eq 'Placement') {
                   14899:         $showncrstype = 'placement test'; 
                   14900:     } else {  
                   14901:         $showncrstype = lc($args->{'crstype'});
                   14902:     }
1.444     albertel 14903:     my %cenv=();
                   14904:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   14905:                                              $args->{'cdescr'},
                   14906:                                              $args->{'curl'},
                   14907:                                              $args->{'course_home'},
                   14908:                                              $args->{'nonstandard'},
                   14909:                                              $args->{'crscode'},
                   14910:                                              $args->{'ccuname'}.':'.
                   14911:                                              $args->{'ccdomain'},
1.882     raeburn  14912:                                              $args->{'crstype'},
1.885     raeburn  14913:                                              $cnum,$context,$category);
1.444     albertel 14914: 
                   14915:     # Note: The testing routines depend on this being output; see 
                   14916:     # Utils::Course. This needs to at least be output as a comment
                   14917:     # if anyone ever decides to not show this, and Utils::Course::new
                   14918:     # will need to be suitably modified.
1.1239    raeburn  14919:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943     raeburn  14920:     if ($$courseid =~ /^error:/) {
                   14921:         return (0,$outcome);
                   14922:     }
                   14923: 
1.444     albertel 14924: #
                   14925: # Check if created correctly
                   14926: #
1.479     albertel 14927:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14928:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14929:     if ($crsuhome eq 'no_host') {
                   14930:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14931:         return (0,$outcome);
                   14932:     }
1.541     raeburn  14933:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14934: 
1.444     albertel 14935: #
1.566     albertel 14936: # Do the cloning
                   14937: #   
                   14938:     if ($can_clone && $cloneid) {
1.1239    raeburn  14939: 	$clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566     albertel 14940: 	if ($context ne 'auto') {
                   14941: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14942: 	}
                   14943: 	$outcome .= $clonemsg.$linefeed;
                   14944: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14945: # Copy all files
1.637     www      14946: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14947: # Restore URL
1.566     albertel 14948: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14949: # Restore title
1.566     albertel 14950: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14951: # Restore creation date, creator and creation context.
                   14952:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14953:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14954:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14955: # Mark as cloned
1.566     albertel 14956: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14957: # Need to clone grading mode
                   14958:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14959:         $cenv{'grading'}=$newenv{'grading'};
                   14960: # Do not clone these environment entries
                   14961:         &Apache::lonnet::del('environment',
                   14962:                   ['default_enrollment_start_date',
                   14963:                    'default_enrollment_end_date',
                   14964:                    'question.email',
                   14965:                    'policy.email',
                   14966:                    'comment.email',
                   14967:                    'pch.users.denied',
1.725     raeburn  14968:                    'plc.users.denied',
                   14969:                    'hidefromcat',
1.1121    raeburn  14970:                    'checkforpriv',
1.1166    raeburn  14971:                    'categories',
                   14972:                    'internal.uniquecode'],
1.638     www      14973:                    $$crsudom,$$crsunum);
1.1170    raeburn  14974:         if ($args->{'textbook'}) {
                   14975:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14976:         }
1.444     albertel 14977:     }
1.566     albertel 14978: 
1.444     albertel 14979: #
                   14980: # Set environment (will override cloned, if existing)
                   14981: #
                   14982:     my @sections = ();
                   14983:     my @xlists = ();
                   14984:     if ($args->{'crstype'}) {
                   14985:         $cenv{'type'}=$args->{'crstype'};
                   14986:     }
                   14987:     if ($args->{'crsid'}) {
                   14988:         $cenv{'courseid'}=$args->{'crsid'};
                   14989:     }
                   14990:     if ($args->{'crscode'}) {
                   14991:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14992:     }
                   14993:     if ($args->{'crsquota'} ne '') {
                   14994:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14995:     } else {
                   14996:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14997:     }
                   14998:     if ($args->{'ccuname'}) {
                   14999:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   15000:                                         ':'.$args->{'ccdomain'};
                   15001:     } else {
                   15002:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   15003:     }
1.1116    raeburn  15004:     if ($args->{'defaultcredits'}) {
                   15005:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   15006:     }
1.444     albertel 15007:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   15008:     if ($args->{'crssections'}) {
                   15009:         $cenv{'internal.sectionnums'} = '';
                   15010:         if ($args->{'crssections'} =~ m/,/) {
                   15011:             @sections = split/,/,$args->{'crssections'};
                   15012:         } else {
                   15013:             $sections[0] = $args->{'crssections'};
                   15014:         }
                   15015:         if (@sections > 0) {
                   15016:             foreach my $item (@sections) {
                   15017:                 my ($sec,$gp) = split/:/,$item;
                   15018:                 my $class = $args->{'crscode'}.$sec;
                   15019:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   15020:                 $cenv{'internal.sectionnums'} .= $item.',';
                   15021:                 unless ($addcheck eq 'ok') {
                   15022:                     push @badclasses, $class;
                   15023:                 }
                   15024:             }
                   15025:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   15026:         }
                   15027:     }
                   15028: # do not hide course coordinator from staff listing, 
                   15029: # even if privileged
                   15030:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  15031: # add course coordinator's domain to domains to check for privileged users
                   15032: # if different to course domain
                   15033:     if ($$crsudom ne $args->{'ccdomain'}) {
                   15034:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   15035:     }
1.444     albertel 15036: # add crosslistings
                   15037:     if ($args->{'crsxlist'}) {
                   15038:         $cenv{'internal.crosslistings'}='';
                   15039:         if ($args->{'crsxlist'} =~ m/,/) {
                   15040:             @xlists = split/,/,$args->{'crsxlist'};
                   15041:         } else {
                   15042:             $xlists[0] = $args->{'crsxlist'};
                   15043:         }
                   15044:         if (@xlists > 0) {
                   15045:             foreach my $item (@xlists) {
                   15046:                 my ($xl,$gp) = split/:/,$item;
                   15047:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   15048:                 $cenv{'internal.crosslistings'} .= $item.',';
                   15049:                 unless ($addcheck eq 'ok') {
                   15050:                     push @badclasses, $xl;
                   15051:                 }
                   15052:             }
                   15053:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   15054:         }
                   15055:     }
                   15056:     if ($args->{'autoadds'}) {
                   15057:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   15058:     }
                   15059:     if ($args->{'autodrops'}) {
                   15060:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   15061:     }
                   15062: # check for notification of enrollment changes
                   15063:     my @notified = ();
                   15064:     if ($args->{'notify_owner'}) {
                   15065:         if ($args->{'ccuname'} ne '') {
                   15066:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   15067:         }
                   15068:     }
                   15069:     if ($args->{'notify_dc'}) {
                   15070:         if ($uname ne '') { 
1.630     raeburn  15071:             push(@notified,$uname.':'.$udom);
1.444     albertel 15072:         }
                   15073:     }
                   15074:     if (@notified > 0) {
                   15075:         my $notifylist;
                   15076:         if (@notified > 1) {
                   15077:             $notifylist = join(',',@notified);
                   15078:         } else {
                   15079:             $notifylist = $notified[0];
                   15080:         }
                   15081:         $cenv{'internal.notifylist'} = $notifylist;
                   15082:     }
                   15083:     if (@badclasses > 0) {
                   15084:         my %lt=&Apache::lonlocal::texthash(
                   15085:                 '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',
                   15086:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   15087:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   15088:         );
1.541     raeburn  15089:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   15090:                            ' ('.$lt{'adby'}.')';
                   15091:         if ($context eq 'auto') {
                   15092:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 15093:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  15094:             foreach my $item (@badclasses) {
                   15095:                 if ($context eq 'auto') {
                   15096:                     $outcome .= " - $item\n";
                   15097:                 } else {
                   15098:                     $outcome .= "<li>$item</li>\n";
                   15099:                 }
                   15100:             }
                   15101:             if ($context eq 'auto') {
                   15102:                 $outcome .= $linefeed;
                   15103:             } else {
1.566     albertel 15104:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  15105:             }
                   15106:         } 
1.444     albertel 15107:     }
                   15108:     if ($args->{'no_end_date'}) {
                   15109:         $args->{'endaccess'} = 0;
                   15110:     }
                   15111:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   15112:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   15113:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   15114:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   15115:     if ($args->{'showphotos'}) {
                   15116:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   15117:     }
                   15118:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   15119:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   15120:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   15121:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  15122:             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'); 
                   15123:             if ($context eq 'auto') {
                   15124:                 $outcome .= $krb_msg;
                   15125:             } else {
1.566     albertel 15126:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  15127:             }
                   15128:             $outcome .= $linefeed;
1.444     albertel 15129:         }
                   15130:     }
                   15131:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   15132:        if ($args->{'setpolicy'}) {
                   15133:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15134:        }
                   15135:        if ($args->{'setcontent'}) {
                   15136:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15137:        }
                   15138:     }
                   15139:     if ($args->{'reshome'}) {
                   15140: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   15141: 	$cenv{'reshome'}=~s/\/+$/\//;
                   15142:     }
                   15143: #
                   15144: # course has keyed access
                   15145: #
                   15146:     if ($args->{'setkeys'}) {
                   15147:        $cenv{'keyaccess'}='yes';
                   15148:     }
                   15149: # if specified, key authority is not course, but user
                   15150: # only active if keyaccess is yes
                   15151:     if ($args->{'keyauth'}) {
1.487     albertel 15152: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   15153: 	$user = &LONCAPA::clean_username($user);
                   15154: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     15155: 	if ($user ne '' && $domain ne '') {
1.487     albertel 15156: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 15157: 	}
                   15158:     }
                   15159: 
1.1166    raeburn  15160: #
1.1167    raeburn  15161: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  15162: #
                   15163:     if ($args->{'uniquecode'}) {
                   15164:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   15165:         if ($code) {
                   15166:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  15167:             my %crsinfo =
                   15168:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   15169:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   15170:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   15171:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   15172:             } 
1.1166    raeburn  15173:             if (ref($coderef)) {
                   15174:                 $$coderef = $code;
                   15175:             }
                   15176:         }
                   15177:     }
                   15178: 
1.444     albertel 15179:     if ($args->{'disresdis'}) {
                   15180:         $cenv{'pch.roles.denied'}='st';
                   15181:     }
                   15182:     if ($args->{'disablechat'}) {
                   15183:         $cenv{'plc.roles.denied'}='st';
                   15184:     }
                   15185: 
                   15186:     # Record we've not yet viewed the Course Initialization Helper for this 
                   15187:     # course
                   15188:     $cenv{'course.helper.not.run'} = 1;
                   15189:     #
                   15190:     # Use new Randomseed
                   15191:     #
                   15192:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   15193:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   15194:     #
                   15195:     # The encryption code and receipt prefix for this course
                   15196:     #
                   15197:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   15198:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   15199:     #
                   15200:     # By default, use standard grading
                   15201:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   15202: 
1.541     raeburn  15203:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   15204:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15205: #
                   15206: # Open all assignments
                   15207: #
                   15208:     if ($args->{'openall'}) {
                   15209:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   15210:        my %storecontent = ($storeunder         => time,
                   15211:                            $storeunder.'.type' => 'date_start');
                   15212:        
                   15213:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  15214:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15215:    }
                   15216: #
                   15217: # Set first page
                   15218: #
                   15219:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   15220: 	    || ($cloneid)) {
1.445     albertel 15221: 	use LONCAPA::map;
1.444     albertel 15222: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 15223: 
                   15224: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   15225:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   15226: 
1.444     albertel 15227:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   15228:         my $title; my $url;
                   15229:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   15230: 	    $title=&mt('Syllabus');
1.444     albertel 15231:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   15232:         } else {
1.963     raeburn  15233:             $title=&mt('Table of Contents');
1.444     albertel 15234:             $url='/adm/navmaps';
                   15235:         }
1.445     albertel 15236: 
                   15237:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   15238: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   15239: 
                   15240: 	if ($errtext) { $fatal=2; }
1.541     raeburn  15241:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 15242:     }
1.566     albertel 15243: 
1.1237    raeburn  15244: # 
                   15245: # Set params for Placement Tests
                   15246: #
1.1239    raeburn  15247:     if ($args->{'crstype'} eq 'Placement') {
                   15248:        my %storecontent; 
                   15249:        my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
                   15250:        my %defaults = (
                   15251:                         buttonshide   => { value => 'yes',
                   15252:                                            type => 'string_yesno',},
                   15253:                         type          => { value => 'randomizetry',
                   15254:                                            type  => 'string_questiontype',},
                   15255:                         maxtries      => { value => 1,
                   15256:                                            type => 'int_pos',},
                   15257:                         problemstatus => { value => 'no',
                   15258:                                            type  => 'string_problemstatus',},
                   15259:                       );
                   15260:        foreach my $key (keys(%defaults)) {
                   15261:            $storecontent{$prefix.$key} = $defaults{$key}{'value'};
                   15262:            $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
                   15263:        }
1.1237    raeburn  15264:        &Apache::lonnet::cput
                   15265:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
                   15266:     }
                   15267: 
1.566     albertel 15268:     return (1,$outcome);
1.444     albertel 15269: }
                   15270: 
1.1166    raeburn  15271: sub make_unique_code {
                   15272:     my ($cdom,$cnum) = @_;
                   15273:     # get lock on uniquecodes db
                   15274:     my $lockhash = {
                   15275:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   15276:                                                   ':'.$env{'user.domain'},
                   15277:                    };
                   15278:     my $tries = 0;
                   15279:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15280:     my ($code,$error);
                   15281:   
                   15282:     while (($gotlock ne 'ok') && ($tries<3)) {
                   15283:         $tries ++;
                   15284:         sleep 1;
                   15285:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15286:     }
                   15287:     if ($gotlock eq 'ok') {
                   15288:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   15289:         my $gotcode;
                   15290:         my $attempts = 0;
                   15291:         while ((!$gotcode) && ($attempts < 100)) {
                   15292:             $code = &generate_code();
                   15293:             if (!exists($currcodes{$code})) {
                   15294:                 $gotcode = 1;
                   15295:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   15296:                     $error = 'nostore';
                   15297:                 }
                   15298:             }
                   15299:             $attempts ++;
                   15300:         }
                   15301:         my @del_lock = ($cnum."\0".'uniquecodes');
                   15302:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   15303:     } else {
                   15304:         $error = 'nolock';
                   15305:     }
                   15306:     return ($code,$error);
                   15307: }
                   15308: 
                   15309: sub generate_code {
                   15310:     my $code;
                   15311:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   15312:     for (my $i=0; $i<6; $i++) {
                   15313:         my $lettnum = int (rand 2);
                   15314:         my $item = '';
                   15315:         if ($lettnum) {
                   15316:             $item = $letts[int( rand(18) )];
                   15317:         } else {
                   15318:             $item = 1+int( rand(8) );
                   15319:         }
                   15320:         $code .= $item;
                   15321:     }
                   15322:     return $code;
                   15323: }
                   15324: 
1.444     albertel 15325: ############################################################
                   15326: ############################################################
                   15327: 
1.1237    raeburn  15328: # Community, Course and Placement Test
1.378     raeburn  15329: sub course_type {
                   15330:     my ($cid) = @_;
                   15331:     if (!defined($cid)) {
                   15332:         $cid = $env{'request.course.id'};
                   15333:     }
1.404     albertel 15334:     if (defined($env{'course.'.$cid.'.type'})) {
                   15335:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  15336:     } else {
                   15337:         return 'Course';
1.377     raeburn  15338:     }
                   15339: }
1.156     albertel 15340: 
1.406     raeburn  15341: sub group_term {
                   15342:     my $crstype = &course_type();
                   15343:     my %names = (
                   15344:                   'Course' => 'group',
1.865     raeburn  15345:                   'Community' => 'group',
1.1237    raeburn  15346:                   'Placement' => 'group',
1.406     raeburn  15347:                 );
                   15348:     return $names{$crstype};
                   15349: }
                   15350: 
1.902     raeburn  15351: sub course_types {
1.1237    raeburn  15352:     my @types = ('official','unofficial','community','textbook','placement');
1.902     raeburn  15353:     my %typename = (
                   15354:                          official   => 'Official course',
                   15355:                          unofficial => 'Unofficial course',
                   15356:                          community  => 'Community',
1.1165    raeburn  15357:                          textbook   => 'Textbook course',
1.1237    raeburn  15358:                          placement  => 'Placement test',
1.902     raeburn  15359:                    );
                   15360:     return (\@types,\%typename);
                   15361: }
                   15362: 
1.156     albertel 15363: sub icon {
                   15364:     my ($file)=@_;
1.505     albertel 15365:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 15366:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 15367:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 15368:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   15369: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   15370: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15371: 	            $curfext.".gif") {
                   15372: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15373: 		$curfext.".gif";
                   15374: 	}
                   15375:     }
1.249     albertel 15376:     return &lonhttpdurl($iconname);
1.154     albertel 15377: } 
1.84      albertel 15378: 
1.575     albertel 15379: sub lonhttpdurl {
1.692     www      15380: #
                   15381: # Had been used for "small fry" static images on separate port 8080.
                   15382: # Modify here if lightweight http functionality desired again.
                   15383: # Currently eliminated due to increasing firewall issues.
                   15384: #
1.575     albertel 15385:     my ($url)=@_;
1.692     www      15386:     return $url;
1.215     albertel 15387: }
                   15388: 
1.213     albertel 15389: sub connection_aborted {
                   15390:     my ($r)=@_;
                   15391:     $r->print(" ");$r->rflush();
                   15392:     my $c = $r->connection;
                   15393:     return $c->aborted();
                   15394: }
                   15395: 
1.221     foxr     15396: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     15397: #    strings as 'strings'.
                   15398: sub escape_single {
1.221     foxr     15399:     my ($input) = @_;
1.223     albertel 15400:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     15401:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   15402:     return $input;
                   15403: }
1.223     albertel 15404: 
1.222     foxr     15405: #  Same as escape_single, but escape's "'s  This 
                   15406: #  can be used for  "strings"
                   15407: sub escape_double {
                   15408:     my ($input) = @_;
                   15409:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   15410:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   15411:     return $input;
                   15412: }
1.223     albertel 15413:  
1.222     foxr     15414: #   Escapes the last element of a full URL.
                   15415: sub escape_url {
                   15416:     my ($url)   = @_;
1.238     raeburn  15417:     my @urlslices = split(/\//, $url,-1);
1.369     www      15418:     my $lastitem = &escape(pop(@urlslices));
1.1203    raeburn  15419:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     15420: }
1.462     albertel 15421: 
1.820     raeburn  15422: sub compare_arrays {
                   15423:     my ($arrayref1,$arrayref2) = @_;
                   15424:     my (@difference,%count);
                   15425:     @difference = ();
                   15426:     %count = ();
                   15427:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   15428:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   15429:         foreach my $element (keys(%count)) {
                   15430:             if ($count{$element} == 1) {
                   15431:                 push(@difference,$element);
                   15432:             }
                   15433:         }
                   15434:     }
                   15435:     return @difference;
                   15436: }
                   15437: 
1.817     bisitz   15438: # -------------------------------------------------------- Initialize user login
1.462     albertel 15439: sub init_user_environment {
1.463     albertel 15440:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 15441:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   15442: 
                   15443:     my $public=($username eq 'public' && $domain eq 'public');
                   15444: 
                   15445: # See if old ID present, if so, remove
                   15446: 
1.1062    raeburn  15447:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 15448:     my $now=time;
                   15449: 
                   15450:     if ($public) {
                   15451: 	my $max_public=100;
                   15452: 	my $oldest;
                   15453: 	my $oldest_time=0;
                   15454: 	for(my $next=1;$next<=$max_public;$next++) {
                   15455: 	    if (-e $lonids."/publicuser_$next.id") {
                   15456: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   15457: 		if ($mtime<$oldest_time || !$oldest_time) {
                   15458: 		    $oldest_time=$mtime;
                   15459: 		    $oldest=$next;
                   15460: 		}
                   15461: 	    } else {
                   15462: 		$cookie="publicuser_$next";
                   15463: 		last;
                   15464: 	    }
                   15465: 	}
                   15466: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   15467:     } else {
1.463     albertel 15468: 	# if this isn't a robot, kill any existing non-robot sessions
                   15469: 	if (!$args->{'robot'}) {
                   15470: 	    opendir(DIR,$lonids);
                   15471: 	    while ($filename=readdir(DIR)) {
                   15472: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   15473: 		    unlink($lonids.'/'.$filename);
                   15474: 		}
1.462     albertel 15475: 	    }
1.463     albertel 15476: 	    closedir(DIR);
1.1204    raeburn  15477: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   15478:             my $namespace = 'nohist_courseeditor';
                   15479:             my $lockingkey = 'paste'."\0".'locked_num';
                   15480:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   15481:                                                 $domain,$username);
                   15482:             if (exists($lockhash{$lockingkey})) {
                   15483:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   15484:                 unless ($delresult eq 'ok') {
                   15485:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   15486:                 }
                   15487:             }
1.462     albertel 15488: 	}
                   15489: # Give them a new cookie
1.463     albertel 15490: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      15491: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 15492: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 15493:     
                   15494: # Initialize roles
                   15495: 
1.1062    raeburn  15496: 	($userroles,$firstaccenv,$timerintenv) = 
                   15497:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 15498:     }
                   15499: # ------------------------------------ Check browser type and MathML capability
                   15500: 
1.1194    raeburn  15501:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   15502:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 15503: 
                   15504: # ------------------------------------------------------------- Get environment
                   15505: 
                   15506:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   15507:     my ($tmp) = keys(%userenv);
                   15508:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   15509:     } else {
                   15510: 	undef(%userenv);
                   15511:     }
                   15512:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   15513: 	$form->{'interface'}=$userenv{'interface'};
                   15514:     }
                   15515:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   15516: 
                   15517: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   15518:     foreach my $option ('interface','localpath','localres') {
                   15519:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 15520:     }
                   15521: # --------------------------------------------------------- Write first profile
                   15522: 
                   15523:     {
                   15524: 	my %initial_env = 
                   15525: 	    ("user.name"          => $username,
                   15526: 	     "user.domain"        => $domain,
                   15527: 	     "user.home"          => $authhost,
                   15528: 	     "browser.type"       => $clientbrowser,
                   15529: 	     "browser.version"    => $clientversion,
                   15530: 	     "browser.mathml"     => $clientmathml,
                   15531: 	     "browser.unicode"    => $clientunicode,
                   15532: 	     "browser.os"         => $clientos,
1.1137    raeburn  15533:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  15534:              "browser.info"       => $clientinfo,
1.1194    raeburn  15535:              "browser.osversion"  => $clientosversion,
1.462     albertel 15536: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   15537: 	     "request.course.fn"  => '',
                   15538: 	     "request.course.uri" => '',
                   15539: 	     "request.course.sec" => '',
                   15540: 	     "request.role"       => 'cm',
                   15541: 	     "request.role.adv"   => $env{'user.adv'},
                   15542: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   15543: 
                   15544:         if ($form->{'localpath'}) {
                   15545: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   15546: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   15547:         }
                   15548: 	
                   15549: 	if ($form->{'interface'}) {
                   15550: 	    $form->{'interface'}=~s/\W//gs;
                   15551: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   15552: 	    $env{'browser.interface'}=$form->{'interface'};
                   15553: 	}
                   15554: 
1.1157    raeburn  15555:         if ($form->{'iptoken'}) {
                   15556:             my $lonhost = $r->dir_config('lonHostID');
                   15557:             $initial_env{"user.noloadbalance"} = $lonhost;
                   15558:             $env{'user.noloadbalance'} = $lonhost;
                   15559:         }
                   15560: 
1.981     raeburn  15561:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  15562:         my %domdef;
                   15563:         unless ($domain eq 'public') {
                   15564:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   15565:         }
1.980     raeburn  15566: 
1.1081    raeburn  15567:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  15568:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  15569:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   15570:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  15571:         }
                   15572: 
1.1237    raeburn  15573:         foreach my $crstype ('official','unofficial','community','textbook','placement') {
1.765     raeburn  15574:             $userenv{'canrequest.'.$crstype} =
                   15575:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  15576:                                                   'reload','requestcourses',
                   15577:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  15578:         }
                   15579: 
1.1092    raeburn  15580:         $userenv{'canrequest.author'} =
                   15581:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   15582:                                         'reload','requestauthor',
                   15583:                                         \%userenv,\%domdef,\%is_adv);
                   15584:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   15585:                                              $domain,$username);
                   15586:         my $reqstatus = $reqauthor{'author_status'};
                   15587:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   15588:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   15589:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   15590:                                                   $reqauthor{'author'}{'timestamp'};
                   15591:             }
                   15592:         }
                   15593: 
1.462     albertel 15594: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  15595: 
1.462     albertel 15596: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   15597: 		 &GDBM_WRCREAT(),0640)) {
                   15598: 	    &_add_to_env(\%disk_env,\%initial_env);
                   15599: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   15600: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  15601:             if (ref($firstaccenv) eq 'HASH') {
                   15602:                 &_add_to_env(\%disk_env,$firstaccenv);
                   15603:             }
                   15604:             if (ref($timerintenv) eq 'HASH') {
                   15605:                 &_add_to_env(\%disk_env,$timerintenv);
                   15606:             }
1.463     albertel 15607: 	    if (ref($args->{'extra_env'})) {
                   15608: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   15609: 	    }
1.462     albertel 15610: 	    untie(%disk_env);
                   15611: 	} else {
1.705     tempelho 15612: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   15613: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 15614: 	    return 'error: '.$!;
                   15615: 	}
                   15616:     }
                   15617:     $env{'request.role'}='cm';
                   15618:     $env{'request.role.adv'}=$env{'user.adv'};
                   15619:     $env{'browser.type'}=$clientbrowser;
                   15620: 
                   15621:     return $cookie;
                   15622: 
                   15623: }
                   15624: 
                   15625: sub _add_to_env {
                   15626:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  15627:     if (ref($env_data) eq 'HASH') {
                   15628:         while (my ($key,$value) = each(%$env_data)) {
                   15629: 	    $idf->{$prefix.$key} = $value;
                   15630: 	    $env{$prefix.$key}   = $value;
                   15631:         }
1.462     albertel 15632:     }
                   15633: }
                   15634: 
1.685     tempelho 15635: # --- Get the symbolic name of a problem and the url
                   15636: sub get_symb {
                   15637:     my ($request,$silent) = @_;
1.726     raeburn  15638:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 15639:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   15640:     if ($symb eq '') {
                   15641:         if (!$silent) {
1.1071    raeburn  15642:             if (ref($request)) { 
                   15643:                 $request->print("Unable to handle ambiguous references:$url:.");
                   15644:             }
1.685     tempelho 15645:             return ();
                   15646:         }
                   15647:     }
                   15648:     &Apache::lonenc::check_decrypt(\$symb);
                   15649:     return ($symb);
                   15650: }
                   15651: 
                   15652: # --------------------------------------------------------------Get annotation
                   15653: 
                   15654: sub get_annotation {
                   15655:     my ($symb,$enc) = @_;
                   15656: 
                   15657:     my $key = $symb;
                   15658:     if (!$enc) {
                   15659:         $key =
                   15660:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   15661:     }
                   15662:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   15663:     return $annotation{$key};
                   15664: }
                   15665: 
                   15666: sub clean_symb {
1.731     raeburn  15667:     my ($symb,$delete_enc) = @_;
1.685     tempelho 15668: 
                   15669:     &Apache::lonenc::check_decrypt(\$symb);
                   15670:     my $enc = $env{'request.enc'};
1.731     raeburn  15671:     if ($delete_enc) {
1.730     raeburn  15672:         delete($env{'request.enc'});
                   15673:     }
1.685     tempelho 15674: 
                   15675:     return ($symb,$enc);
                   15676: }
1.462     albertel 15677: 
1.1181    raeburn  15678: ############################################################
                   15679: ############################################################
                   15680: 
                   15681: =pod
                   15682: 
                   15683: =head1 Routines for building display used to search for courses
                   15684: 
                   15685: 
                   15686: =over 4
                   15687: 
                   15688: =item * &build_filters()
                   15689: 
                   15690: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  15691: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   15692: and quotacheck.pl
                   15693: 
1.1181    raeburn  15694: 
                   15695: Inputs:
                   15696: 
                   15697: filterlist - anonymous array of fields to include as potential filters 
                   15698: 
                   15699: crstype - course type
                   15700: 
                   15701: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   15702:               to pop-open a course selector (will contain "extra element"). 
                   15703: 
                   15704: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   15705: 
                   15706: filter - anonymous hash of criteria and their values
                   15707: 
                   15708: action - form action
                   15709: 
                   15710: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   15711: 
1.1182    raeburn  15712: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  15713: 
                   15714: cloneruname - username of owner of new course who wants to clone
                   15715: 
                   15716: clonerudom - domain of owner of new course who wants to clone
                   15717: 
                   15718: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   15719: 
                   15720: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   15721: 
                   15722: codedom - domain
                   15723: 
                   15724: formname - value of form element named "form". 
                   15725: 
                   15726: fixeddom - domain, if fixed.
                   15727: 
                   15728: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   15729: 
                   15730: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   15731: 
                   15732: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   15733: 
                   15734: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   15735: 
                   15736: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   15737: 
                   15738: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   15739: 
                   15740: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   15741: 
1.1182    raeburn  15742: 
1.1181    raeburn  15743: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   15744: 
1.1182    raeburn  15745: 
1.1181    raeburn  15746: Side Effects: None
                   15747: 
                   15748: =cut
                   15749: 
                   15750: # ---------------------------------------------- search for courses based on last activity etc.
                   15751: 
                   15752: sub build_filters {
                   15753:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   15754:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   15755:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   15756:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   15757:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  15758:     my ($list,$jscript);
1.1181    raeburn  15759:     my $onchange = 'javascript:updateFilters(this)';
                   15760:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   15761:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   15762:         $typeselectform,$instcodetitle);
                   15763:     if ($formname eq '') {
                   15764:         $formname = $caller;
                   15765:     }
                   15766:     foreach my $item (@{$filterlist}) {
                   15767:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   15768:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   15769:             if ($item eq 'domainfilter') {
                   15770:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   15771:             } elsif ($item eq 'coursefilter') {
                   15772:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   15773:             } elsif ($item eq 'ownerfilter') {
                   15774:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15775:             } elsif ($item eq 'ownerdomfilter') {
                   15776:                 $filter->{'ownerdomfilter'} =
                   15777:                     &LONCAPA::clean_domain($filter->{$item});
                   15778:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   15779:                                                        'ownerdomfilter',1);
                   15780:             } elsif ($item eq 'personfilter') {
                   15781:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15782:             } elsif ($item eq 'persondomfilter') {
                   15783:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   15784:                                                         'persondomfilter',1);
                   15785:             } else {
                   15786:                 $filter->{$item} =~ s/\W//g;
                   15787:             }
                   15788:             if (!$filter->{$item}) {
                   15789:                 $filter->{$item} = '';
                   15790:             }
                   15791:         }
                   15792:         if ($item eq 'domainfilter') {
                   15793:             my $allow_blank = 1;
                   15794:             if ($formname eq 'portform') {
                   15795:                 $allow_blank=0;
                   15796:             } elsif ($formname eq 'studentform') {
                   15797:                 $allow_blank=0;
                   15798:             }
                   15799:             if ($fixeddom) {
                   15800:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   15801:                                     ' value="'.$codedom.'" />'.
                   15802:                                     &Apache::lonnet::domain($codedom,'description');
                   15803:             } else {
                   15804:                 $domainselectform = &select_dom_form($filter->{$item},
                   15805:                                                      'domainfilter',
                   15806:                                                       $allow_blank,'',$onchange);
                   15807:             }
                   15808:         } else {
                   15809:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   15810:         }
                   15811:     }
                   15812: 
                   15813:     # last course activity filter and selection
                   15814:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   15815: 
                   15816:     # course created filter and selection
                   15817:     if (exists($filter->{'createdfilter'})) {
                   15818:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   15819:     }
                   15820: 
1.1239    raeburn  15821:     my $prefix = $crstype;
                   15822:     if ($crstype eq 'Placement') {
                   15823:         $prefix = 'Placement Test'
                   15824:     }
1.1181    raeburn  15825:     my %lt = &Apache::lonlocal::texthash(
1.1239    raeburn  15826:                 'cac' => "$prefix Activity",
                   15827:                 'ccr' => "$prefix Created",
                   15828:                 'cde' => "$prefix Title",
                   15829:                 'cdo' => "$prefix Domain",
1.1181    raeburn  15830:                 'ins' => 'Institutional Code',
                   15831:                 'inc' => 'Institutional Categorization',
1.1239    raeburn  15832:                 'cow' => "$prefix Owner/Co-owner",
                   15833:                 'cop' => "$prefix Personnel Includes",
1.1181    raeburn  15834:                 'cog' => 'Type',
                   15835:              );
                   15836: 
                   15837:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15838:         my $typeval = 'Course';
                   15839:         if ($crstype eq 'Community') {
                   15840:             $typeval = 'Community';
1.1239    raeburn  15841:         } elsif ($crstype eq 'Placement') {
                   15842:             $typeval = 'Placement';
1.1181    raeburn  15843:         }
                   15844:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   15845:     } else {
                   15846:         $typeselectform =  '<select name="type" size="1"';
                   15847:         if ($onchange) {
                   15848:             $typeselectform .= ' onchange="'.$onchange.'"';
                   15849:         }
                   15850:         $typeselectform .= '>'."\n";
1.1237    raeburn  15851:         foreach my $posstype ('Course','Community','Placement') {
1.1239    raeburn  15852:             my $shown;
                   15853:             if ($posstype eq 'Placement') {
                   15854:                 $shown = &mt('Placement Test');
                   15855:             } else {
                   15856:                 $shown = &mt($posstype);
                   15857:             }
1.1181    raeburn  15858:             $typeselectform.='<option value="'.$posstype.'"'.
1.1239    raeburn  15859:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181    raeburn  15860:         }
                   15861:         $typeselectform.="</select>";
                   15862:     }
                   15863: 
                   15864:     my ($cloneableonlyform,$cloneabletitle);
                   15865:     if (exists($filter->{'cloneableonly'})) {
                   15866:         my $cloneableon = '';
                   15867:         my $cloneableoff = ' checked="checked"';
                   15868:         if ($filter->{'cloneableonly'}) {
                   15869:             $cloneableon = $cloneableoff;
                   15870:             $cloneableoff = '';
                   15871:         }
                   15872:         $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>';
                   15873:         if ($formname eq 'ccrs') {
1.1187    bisitz   15874:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181    raeburn  15875:         } else {
                   15876:             $cloneabletitle = &mt('Cloneable by you');
                   15877:         }
                   15878:     }
                   15879:     my $officialjs;
                   15880:     if ($crstype eq 'Course') {
                   15881:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  15882: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   15883: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   15884:             if ($codedom) { 
1.1181    raeburn  15885:                 $officialjs = 1;
                   15886:                 ($instcodeform,$jscript,$$numtitlesref) =
                   15887:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   15888:                                                                   $officialjs,$codetitlesref);
                   15889:                 if ($jscript) {
1.1182    raeburn  15890:                     $jscript = '<script type="text/javascript">'."\n".
                   15891:                                '// <![CDATA['."\n".
                   15892:                                $jscript."\n".
                   15893:                                '// ]]>'."\n".
                   15894:                                '</script>'."\n";
1.1181    raeburn  15895:                 }
                   15896:             }
                   15897:             if ($instcodeform eq '') {
                   15898:                 $instcodeform =
                   15899:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   15900:                     $list->{'instcodefilter'}.'" />';
                   15901:                 $instcodetitle = $lt{'ins'};
                   15902:             } else {
                   15903:                 $instcodetitle = $lt{'inc'};
                   15904:             }
                   15905:             if ($fixeddom) {
                   15906:                 $instcodetitle .= '<br />('.$codedom.')';
                   15907:             }
                   15908:         }
                   15909:     }
                   15910:     my $output = qq|
                   15911: <form method="post" name="filterpicker" action="$action">
                   15912: <input type="hidden" name="form" value="$formname" />
                   15913: |;
                   15914:     if ($formname eq 'modifycourse') {
                   15915:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   15916:                    '<input type="hidden" name="prevphase" value="'.
                   15917:                    $prevphase.'" />'."\n";
1.1198    musolffc 15918:     } elsif ($formname eq 'quotacheck') {
                   15919:         $output .= qq|
                   15920: <input type="hidden" name="sortby" value="" />
                   15921: <input type="hidden" name="sortorder" value="" />
                   15922: |;
                   15923:     } else {
1.1181    raeburn  15924:         my $name_input;
                   15925:         if ($cnameelement ne '') {
                   15926:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   15927:                           $cnameelement.'" />';
                   15928:         }
                   15929:         $output .= qq|
1.1182    raeburn  15930: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   15931: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  15932: $name_input
                   15933: $roleelement
                   15934: $multelement
                   15935: $typeelement
                   15936: |;
                   15937:         if ($formname eq 'portform') {
                   15938:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   15939:         }
                   15940:     }
                   15941:     if ($fixeddom) {
                   15942:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   15943:     }
                   15944:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   15945:     if ($sincefilterform) {
                   15946:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   15947:                   .$sincefilterform
                   15948:                   .&Apache::lonhtmlcommon::row_closure();
                   15949:     }
                   15950:     if ($createdfilterform) {
                   15951:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   15952:                   .$createdfilterform
                   15953:                   .&Apache::lonhtmlcommon::row_closure();
                   15954:     }
                   15955:     if ($domainselectform) {
                   15956:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   15957:                   .$domainselectform
                   15958:                   .&Apache::lonhtmlcommon::row_closure();
                   15959:     }
                   15960:     if ($typeselectform) {
                   15961:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15962:             $output .= $typeselectform;
                   15963:         } else {
                   15964:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   15965:                       .$typeselectform
                   15966:                       .&Apache::lonhtmlcommon::row_closure();
                   15967:         }
                   15968:     }
                   15969:     if ($instcodeform) {
                   15970:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   15971:                   .$instcodeform
                   15972:                   .&Apache::lonhtmlcommon::row_closure();
                   15973:     }
                   15974:     if (exists($filter->{'ownerfilter'})) {
                   15975:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   15976:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15977:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   15978:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15979:                    $ownerdomselectform.'</td></tr></table>'.
                   15980:                    &Apache::lonhtmlcommon::row_closure();
                   15981:     }
                   15982:     if (exists($filter->{'personfilter'})) {
                   15983:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   15984:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15985:                    '<input type="text" name="personfilter" size="20" value="'.
                   15986:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15987:                    $persondomselectform.'</td></tr></table>'.
                   15988:                    &Apache::lonhtmlcommon::row_closure();
                   15989:     }
                   15990:     if (exists($filter->{'coursefilter'})) {
                   15991:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   15992:                   .'<input type="text" name="coursefilter" size="25" value="'
                   15993:                   .$list->{'coursefilter'}.'" />'
                   15994:                   .&Apache::lonhtmlcommon::row_closure();
                   15995:     }
                   15996:     if ($cloneableonlyform) {
                   15997:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   15998:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   15999:     }
                   16000:     if (exists($filter->{'descriptfilter'})) {
                   16001:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   16002:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   16003:                   .$list->{'descriptfilter'}.'" />'
                   16004:                   .&Apache::lonhtmlcommon::row_closure(1);
                   16005:     }
                   16006:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   16007:                '<input type="hidden" name="updater" value="" />'."\n".
                   16008:                '<input type="submit" name="gosearch" value="'.
                   16009:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   16010:     return $jscript.$clonewarning.$output;
                   16011: }
                   16012: 
                   16013: =pod 
                   16014: 
                   16015: =item * &timebased_select_form()
                   16016: 
1.1182    raeburn  16017: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  16018: filter e.g., Course Activity, Course Created, when searching for courses
                   16019: or communities
                   16020: 
                   16021: Inputs:
                   16022: 
                   16023: item - name of form element (sincefilter or createdfilter)
                   16024: 
                   16025: filter - anonymous hash of criteria and their values
                   16026: 
                   16027: Returns: HTML for a select box contained a blank, then six time selections,
                   16028:          with value set in incoming form variables currently selected. 
                   16029: 
                   16030: Side Effects: None
                   16031: 
                   16032: =cut
                   16033: 
                   16034: sub timebased_select_form {
                   16035:     my ($item,$filter) = @_;
                   16036:     if (ref($filter) eq 'HASH') {
                   16037:         $filter->{$item} =~ s/[^\d-]//g;
                   16038:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   16039:         return &select_form(
                   16040:                             $filter->{$item},
                   16041:                             $item,
                   16042:                             {      '-1' => '',
                   16043:                                 '86400' => &mt('today'),
                   16044:                                '604800' => &mt('last week'),
                   16045:                               '2592000' => &mt('last month'),
                   16046:                               '7776000' => &mt('last three months'),
                   16047:                              '15552000' => &mt('last six months'),
                   16048:                              '31104000' => &mt('last year'),
                   16049:                     'select_form_order' =>
                   16050:                            ['-1','86400','604800','2592000','7776000',
                   16051:                             '15552000','31104000']});
                   16052:     }
                   16053: }
                   16054: 
                   16055: =pod
                   16056: 
                   16057: =item * &js_changer()
                   16058: 
                   16059: Create script tag containing Javascript used to submit course search form
1.1183    raeburn  16060: when course type or domain is changed, and also to hide 'Searching ...' on
                   16061: page load completion for page showing search result.
1.1181    raeburn  16062: 
                   16063: Inputs: None
                   16064: 
1.1183    raeburn  16065: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  16066: 
                   16067: Side Effects: None
                   16068: 
                   16069: =cut
                   16070: 
                   16071: sub js_changer {
                   16072:     return <<ENDJS;
                   16073: <script type="text/javascript">
                   16074: // <![CDATA[
                   16075: function updateFilters(caller) {
                   16076:     if (typeof(caller) != "undefined") {
                   16077:         document.filterpicker.updater.value = caller.name;
                   16078:     }
                   16079:     document.filterpicker.submit();
                   16080: }
1.1183    raeburn  16081: 
                   16082: function hideSearching() {
                   16083:     if (document.getElementById('searching')) {
                   16084:         document.getElementById('searching').style.display = 'none';
                   16085:     }
                   16086:     return;
                   16087: }
                   16088: 
1.1181    raeburn  16089: // ]]>
                   16090: </script>
                   16091: 
                   16092: ENDJS
                   16093: }
                   16094: 
                   16095: =pod
                   16096: 
1.1182    raeburn  16097: =item * &search_courses()
                   16098: 
                   16099: Process selected filters form course search form and pass to lonnet::courseiddump
                   16100: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   16101: 
                   16102: Inputs:
                   16103: 
                   16104: dom - domain being searched 
                   16105: 
                   16106: type - course type ('Course' or 'Community' or '.' if any).
                   16107: 
                   16108: filter - anonymous hash of criteria and their values
                   16109: 
                   16110: numtitles - for institutional codes - number of categories
                   16111: 
                   16112: cloneruname - optional username of new course owner
                   16113: 
                   16114: clonerudom - optional domain of new course owner
                   16115: 
1.1221    raeburn  16116: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
1.1182    raeburn  16117:             (used when DC is using course creation form)
                   16118: 
                   16119: codetitles - reference to array of titles of components in institutional codes (official courses).
                   16120: 
1.1221    raeburn  16121: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   16122:            (and so can clone automatically)
                   16123: 
                   16124: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   16125: 
                   16126: reqinstcode - institutional code of new course, where search_courses is used to identify potential 
                   16127:               courses to clone 
1.1182    raeburn  16128: 
                   16129: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   16130: 
                   16131: 
                   16132: Side Effects: None
                   16133: 
                   16134: =cut
                   16135: 
                   16136: 
                   16137: sub search_courses {
1.1221    raeburn  16138:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   16139:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182    raeburn  16140:     my (%courses,%showcourses,$cloner);
                   16141:     if (($filter->{'ownerfilter'} ne '') ||
                   16142:         ($filter->{'ownerdomfilter'} ne '')) {
                   16143:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   16144:                                        $filter->{'ownerdomfilter'};
                   16145:     }
                   16146:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   16147:         if (!$filter->{$item}) {
                   16148:             $filter->{$item}='.';
                   16149:         }
                   16150:     }
                   16151:     my $now = time;
                   16152:     my $timefilter =
                   16153:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   16154:     my ($createdbefore,$createdafter);
                   16155:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   16156:         $createdbefore = $now;
                   16157:         $createdafter = $now-$filter->{'createdfilter'};
                   16158:     }
                   16159:     my ($instcodefilter,$regexpok);
                   16160:     if ($numtitles) {
                   16161:         if ($env{'form.official'} eq 'on') {
                   16162:             $instcodefilter =
                   16163:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16164:             $regexpok = 1;
                   16165:         } elsif ($env{'form.official'} eq 'off') {
                   16166:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16167:             unless ($instcodefilter eq '') {
                   16168:                 $regexpok = -1;
                   16169:             }
                   16170:         }
                   16171:     } else {
                   16172:         $instcodefilter = $filter->{'instcodefilter'};
                   16173:     }
                   16174:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   16175:     if ($type eq '') { $type = '.'; }
                   16176: 
                   16177:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   16178:         $cloner = $cloneruname.':'.$clonerudom;
                   16179:     }
                   16180:     %courses = &Apache::lonnet::courseiddump($dom,
                   16181:                                              $filter->{'descriptfilter'},
                   16182:                                              $timefilter,
                   16183:                                              $instcodefilter,
                   16184:                                              $filter->{'combownerfilter'},
                   16185:                                              $filter->{'coursefilter'},
                   16186:                                              undef,undef,$type,$regexpok,undef,undef,
1.1221    raeburn  16187:                                              undef,undef,$cloner,$cc_clone,
1.1182    raeburn  16188:                                              $filter->{'cloneableonly'},
                   16189:                                              $createdbefore,$createdafter,undef,
1.1221    raeburn  16190:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182    raeburn  16191:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   16192:         my $ccrole;
                   16193:         if ($type eq 'Community') {
                   16194:             $ccrole = 'co';
                   16195:         } else {
                   16196:             $ccrole = 'cc';
                   16197:         }
                   16198:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   16199:                                                      $filter->{'persondomfilter'},
                   16200:                                                      'userroles',undef,
                   16201:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   16202:                                                      $dom);
                   16203:         foreach my $role (keys(%rolehash)) {
                   16204:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   16205:             my $cid = $cdom.'_'.$cnum;
                   16206:             if (exists($courses{$cid})) {
                   16207:                 if (ref($courses{$cid}) eq 'HASH') {
                   16208:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   16209:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   16210:                             push (@{$courses{$cid}{roles}},$courserole);
                   16211:                         }
                   16212:                     } else {
                   16213:                         $courses{$cid}{roles} = [$courserole];
                   16214:                     }
                   16215:                     $showcourses{$cid} = $courses{$cid};
                   16216:                 }
                   16217:             }
                   16218:         }
                   16219:         %courses = %showcourses;
                   16220:     }
                   16221:     return %courses;
                   16222: }
                   16223: 
                   16224: =pod
                   16225: 
1.1181    raeburn  16226: =back
                   16227: 
1.1207    raeburn  16228: =head1 Routines for version requirements for current course.
                   16229: 
                   16230: =over 4
                   16231: 
                   16232: =item * &check_release_required()
                   16233: 
                   16234: Compares required LON-CAPA version with version on server, and
                   16235: if required version is newer looks for a server with the required version.
                   16236: 
                   16237: Looks first at servers in user's owen domain; if none suitable, looks at
                   16238: servers in course's domain are permitted to host sessions for user's domain.
                   16239: 
                   16240: Inputs:
                   16241: 
                   16242: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16243: 
                   16244: $courseid - Course ID of current course
                   16245: 
                   16246: $rolecode - User's current role in course (for switchserver query string).
                   16247: 
                   16248: $required - LON-CAPA version needed by course (format: Major.Minor).
                   16249: 
                   16250: 
                   16251: Returns:
                   16252: 
                   16253: $switchserver - query string tp append to /adm/switchserver call (if 
                   16254:                 current server's LON-CAPA version is too old. 
                   16255: 
                   16256: $warning - Message is displayed if no suitable server could be found.
                   16257: 
                   16258: =cut
                   16259: 
                   16260: sub check_release_required {
                   16261:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   16262:     my ($switchserver,$warning);
                   16263:     if ($required ne '') {
                   16264:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   16265:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16266:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   16267:             my $otherserver;
                   16268:             if (($major eq '' && $minor eq '') ||
                   16269:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   16270:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   16271:                 my $switchlcrev =
                   16272:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   16273:                                                            $userdomserver);
                   16274:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16275:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   16276:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   16277:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   16278:                     if ($cdom ne $env{'user.domain'}) {
                   16279:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   16280:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   16281:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16282:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   16283:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   16284:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   16285:                         my $canhost =
                   16286:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   16287:                                                               $coursedomserver,
                   16288:                                                               $remoterev,
                   16289:                                                               $udomdefaults{'remotesessions'},
                   16290:                                                               $defdomdefaults{'hostedsessions'});
                   16291: 
                   16292:                         if ($canhost) {
                   16293:                             $otherserver = $coursedomserver;
                   16294:                         } else {
                   16295:                             $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.");
                   16296:                         }
                   16297:                     } else {
                   16298:                         $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).");
                   16299:                     }
                   16300:                 } else {
                   16301:                     $otherserver = $userdomserver;
                   16302:                 }
                   16303:             }
                   16304:             if ($otherserver ne '') {
                   16305:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   16306:             }
                   16307:         }
                   16308:     }
                   16309:     return ($switchserver,$warning);
                   16310: }
                   16311: 
                   16312: =pod
                   16313: 
                   16314: =item * &check_release_result()
                   16315: 
                   16316: Inputs:
                   16317: 
                   16318: $switchwarning - Warning message if no suitable server found to host session.
                   16319: 
                   16320: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16321:                 and current role.
                   16322: 
                   16323: Returns: HTML to display with information about requirement to switch server.
                   16324:          Either displaying warning with link to Roles/Courses screen or
                   16325:          display link to switchserver.
                   16326: 
1.1181    raeburn  16327: =cut
                   16328: 
1.1207    raeburn  16329: sub check_release_result {
                   16330:     my ($switchwarning,$switchserver) = @_;
                   16331:     my $output = &start_page('Selected course unavailable on this server').
                   16332:                  '<p class="LC_warning">';
                   16333:     if ($switchwarning) {
                   16334:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   16335:         if (&show_course()) {
                   16336:             $output .= &mt('Display courses');
                   16337:         } else {
                   16338:             $output .= &mt('Display roles');
                   16339:         }
                   16340:         $output .= '</a>';
                   16341:     } elsif ($switchserver) {
                   16342:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   16343:                    '<br />'.
                   16344:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   16345:                    &mt('Switch Server').
                   16346:                    '</a>';
                   16347:     }
                   16348:     $output .= '</p>'.&end_page();
                   16349:     return $output;
                   16350: }
                   16351: 
                   16352: =pod
                   16353: 
                   16354: =item * &needs_coursereinit()
                   16355: 
                   16356: Determine if course contents stored for user's session needs to be
                   16357: refreshed, because content has changed since "Big Hash" last tied.
                   16358: 
                   16359: Check for change is made if time last checked is more than 10 minutes ago
                   16360: (by default).
                   16361: 
                   16362: Inputs:
                   16363: 
                   16364: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16365: 
                   16366: $interval (optional) - Time which may elapse (in s) between last check for content
                   16367:                        change in current course. (default: 600 s).  
                   16368: 
                   16369: Returns: an array; first element is:
                   16370: 
                   16371: =over 4
                   16372: 
                   16373: 'switch' - if content updates mean user's session
                   16374:            needs to be switched to a server running a newer LON-CAPA version
                   16375:  
                   16376: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   16377:            on current server hosting user's session                
                   16378: 
                   16379: ''       - if no action required.
                   16380: 
                   16381: =back
                   16382: 
                   16383: If first item element is 'switch':
                   16384: 
                   16385: second item is $switchwarning - Warning message if no suitable server found to host session. 
                   16386: 
                   16387: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16388:                               and current role. 
                   16389: 
                   16390: otherwise: no other elements returned.
                   16391: 
                   16392: =back
                   16393: 
                   16394: =cut
                   16395: 
                   16396: sub needs_coursereinit {
                   16397:     my ($loncaparev,$interval) = @_;
                   16398:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   16399:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   16400:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   16401:     my $now = time;
                   16402:     if ($interval eq '') {
                   16403:         $interval = 600;
                   16404:     }
                   16405:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   16406:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16407:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                   16408:         if ($lastchange > $env{'request.course.tied'}) {
                   16409:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16410:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   16411:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   16412:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   16413:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   16414:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   16415:                     my ($switchserver,$switchwarning) =
                   16416:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   16417:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   16418:                     if ($switchwarning ne '' || $switchserver ne '') {
                   16419:                         return ('switch',$switchwarning,$switchserver);
                   16420:                     }
                   16421:                 }
                   16422:             }
                   16423:             return ('update');
                   16424:         }
                   16425:     }
                   16426:     return ();
                   16427: }
1.1181    raeburn  16428: 
1.1083    raeburn  16429: sub update_content_constraints {
                   16430:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16431:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16432:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   16433:     my %checkresponsetypes;
                   16434:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236    raeburn  16435:         my ($item,$name,$value) = split(/:/,$key);
1.1083    raeburn  16436:         if ($item eq 'resourcetag') {
                   16437:             if ($name eq 'responsetype') {
                   16438:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   16439:             }
                   16440:         }
                   16441:     }
                   16442:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16443:     if (defined($navmap)) {
                   16444:         my %allresponses;
                   16445:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   16446:             my %responses = $res->responseTypes();
                   16447:             foreach my $key (keys(%responses)) {
                   16448:                 next unless(exists($checkresponsetypes{$key}));
                   16449:                 $allresponses{$key} += $responses{$key};
                   16450:             }
                   16451:         }
                   16452:         foreach my $key (keys(%allresponses)) {
                   16453:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   16454:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   16455:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   16456:             }
                   16457:         }
                   16458:         undef($navmap);
                   16459:     }
                   16460:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   16461:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   16462:     }
                   16463:     return;
                   16464: }
                   16465: 
1.1110    raeburn  16466: sub allmaps_incourse {
                   16467:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16468:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   16469:         $cid = $env{'request.course.id'};
                   16470:         $cdom = $env{'course.'.$cid.'.domain'};
                   16471:         $cnum = $env{'course.'.$cid.'.num'};
                   16472:         $chome = $env{'course.'.$cid.'.home'};
                   16473:     }
                   16474:     my %allmaps = ();
                   16475:     my $lastchange =
                   16476:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16477:     if ($lastchange > $env{'request.course.tied'}) {
                   16478:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   16479:         unless ($ferr) {
                   16480:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   16481:         }
                   16482:     }
                   16483:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16484:     if (defined($navmap)) {
                   16485:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   16486:             $allmaps{$res->src()} = 1;
                   16487:         }
                   16488:     }
                   16489:     return \%allmaps;
                   16490: }
                   16491: 
1.1083    raeburn  16492: sub parse_supplemental_title {
                   16493:     my ($title) = @_;
                   16494: 
                   16495:     my ($foldertitle,$renametitle);
                   16496:     if ($title =~ /&amp;&amp;&amp;/) {
                   16497:         $title = &HTML::Entites::decode($title);
                   16498:     }
                   16499:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   16500:         $renametitle=$4;
                   16501:         my ($time,$uname,$udom) = ($1,$2,$3);
                   16502:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   16503:         my $name =  &plainname($uname,$udom);
                   16504:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   16505:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   16506:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   16507:             $name.': <br />'.$foldertitle;
                   16508:     }
                   16509:     if (wantarray) {
                   16510:         return ($title,$foldertitle,$renametitle);
                   16511:     }
                   16512:     return $title;
                   16513: }
                   16514: 
1.1143    raeburn  16515: sub recurse_supplemental {
                   16516:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   16517:     if ($suppmap) {
                   16518:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   16519:         if ($fatal) {
                   16520:             $errors ++;
                   16521:         } else {
                   16522:             if ($#LONCAPA::map::resources > 0) {
                   16523:                 foreach my $res (@LONCAPA::map::resources) {
                   16524:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   16525:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  16526:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   16527:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  16528:                         } else {
                   16529:                             $numfiles ++;
                   16530:                         }
                   16531:                     }
                   16532:                 }
                   16533:             }
                   16534:         }
                   16535:     }
                   16536:     return ($numfiles,$errors);
                   16537: }
                   16538: 
1.1101    raeburn  16539: sub symb_to_docspath {
                   16540:     my ($symb) = @_;
                   16541:     return unless ($symb);
                   16542:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   16543:     if ($resurl=~/\.(sequence|page)$/) {
                   16544:         $mapurl=$resurl;
                   16545:     } elsif ($resurl eq 'adm/navmaps') {
                   16546:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   16547:     }
                   16548:     my $mapresobj;
                   16549:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16550:     if (ref($navmap)) {
                   16551:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   16552:     }
                   16553:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   16554:     my $type=$2;
                   16555:     my $path;
                   16556:     if (ref($mapresobj)) {
                   16557:         my $pcslist = $mapresobj->map_hierarchy();
                   16558:         if ($pcslist ne '') {
                   16559:             foreach my $pc (split(/,/,$pcslist)) {
                   16560:                 next if ($pc <= 1);
                   16561:                 my $res = $navmap->getByMapPc($pc);
                   16562:                 if (ref($res)) {
                   16563:                     my $thisurl = $res->src();
                   16564:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   16565:                     my $thistitle = $res->title();
                   16566:                     $path .= '&'.
                   16567:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  16568:                              &escape($thistitle).
1.1101    raeburn  16569:                              ':'.$res->randompick().
                   16570:                              ':'.$res->randomout().
                   16571:                              ':'.$res->encrypted().
                   16572:                              ':'.$res->randomorder().
                   16573:                              ':'.$res->is_page();
                   16574:                 }
                   16575:             }
                   16576:         }
                   16577:         $path =~ s/^\&//;
                   16578:         my $maptitle = $mapresobj->title();
                   16579:         if ($mapurl eq 'default') {
1.1129    raeburn  16580:             $maptitle = 'Main Content';
1.1101    raeburn  16581:         }
                   16582:         $path .= (($path ne '')? '&' : '').
                   16583:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16584:                  &escape($maptitle).
1.1101    raeburn  16585:                  ':'.$mapresobj->randompick().
                   16586:                  ':'.$mapresobj->randomout().
                   16587:                  ':'.$mapresobj->encrypted().
                   16588:                  ':'.$mapresobj->randomorder().
                   16589:                  ':'.$mapresobj->is_page();
                   16590:     } else {
                   16591:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   16592:         my $ispage = (($type eq 'page')? 1 : '');
                   16593:         if ($mapurl eq 'default') {
1.1129    raeburn  16594:             $maptitle = 'Main Content';
1.1101    raeburn  16595:         }
                   16596:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16597:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  16598:     }
                   16599:     unless ($mapurl eq 'default') {
                   16600:         $path = 'default&'.
1.1146    raeburn  16601:                 &escape('Main Content').
1.1101    raeburn  16602:                 ':::::&'.$path;
                   16603:     }
                   16604:     return $path;
                   16605: }
                   16606: 
1.1094    raeburn  16607: sub captcha_display {
                   16608:     my ($context,$lonhost) = @_;
                   16609:     my ($output,$error);
1.1234    raeburn  16610:     my ($captcha,$pubkey,$privkey,$version) = 
                   16611:         &get_captcha_config($context,$lonhost);
1.1095    raeburn  16612:     if ($captcha eq 'original') {
1.1094    raeburn  16613:         $output = &create_captcha();
                   16614:         unless ($output) {
1.1172    raeburn  16615:             $error = 'captcha';
1.1094    raeburn  16616:         }
                   16617:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  16618:         $output = &create_recaptcha($pubkey,$version);
1.1094    raeburn  16619:         unless ($output) {
1.1172    raeburn  16620:             $error = 'recaptcha';
1.1094    raeburn  16621:         }
                   16622:     }
1.1234    raeburn  16623:     return ($output,$error,$captcha,$version);
1.1094    raeburn  16624: }
                   16625: 
                   16626: sub captcha_response {
                   16627:     my ($context,$lonhost) = @_;
                   16628:     my ($captcha_chk,$captcha_error);
1.1234    raeburn  16629:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  16630:     if ($captcha eq 'original') {
1.1094    raeburn  16631:         ($captcha_chk,$captcha_error) = &check_captcha();
                   16632:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  16633:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1094    raeburn  16634:     } else {
                   16635:         $captcha_chk = 1;
                   16636:     }
                   16637:     return ($captcha_chk,$captcha_error);
                   16638: }
                   16639: 
                   16640: sub get_captcha_config {
                   16641:     my ($context,$lonhost) = @_;
1.1234    raeburn  16642:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094    raeburn  16643:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   16644:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   16645:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  16646:     if ($context eq 'usercreation') {
                   16647:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   16648:         if (ref($domconfig{$context}) eq 'HASH') {
                   16649:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   16650:             if (ref($hashtocheck) eq 'HASH') {
                   16651:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   16652:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   16653:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   16654:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   16655:                     }
                   16656:                     if ($privkey && $pubkey) {
                   16657:                         $captcha = 'recaptcha';
1.1234    raeburn  16658:                         $version = $hashtocheck->{'recaptchaversion'};
                   16659:                         if ($version ne '2') {
                   16660:                             $version = 1;
                   16661:                         }
1.1095    raeburn  16662:                     } else {
                   16663:                         $captcha = 'original';
                   16664:                     }
                   16665:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   16666:                     $captcha = 'original';
                   16667:                 }
1.1094    raeburn  16668:             }
1.1095    raeburn  16669:         } else {
                   16670:             $captcha = 'captcha';
                   16671:         }
                   16672:     } elsif ($context eq 'login') {
                   16673:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   16674:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   16675:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   16676:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  16677:             if ($privkey && $pubkey) {
                   16678:                 $captcha = 'recaptcha';
1.1234    raeburn  16679:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   16680:                 if ($version ne '2') {
                   16681:                     $version = 1; 
                   16682:                 }
1.1095    raeburn  16683:             } else {
                   16684:                 $captcha = 'original';
1.1094    raeburn  16685:             }
1.1095    raeburn  16686:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   16687:             $captcha = 'original';
1.1094    raeburn  16688:         }
                   16689:     }
1.1234    raeburn  16690:     return ($captcha,$pubkey,$privkey,$version);
1.1094    raeburn  16691: }
                   16692: 
                   16693: sub create_captcha {
                   16694:     my %captcha_params = &captcha_settings();
                   16695:     my ($output,$maxtries,$tries) = ('',10,0);
                   16696:     while ($tries < $maxtries) {
                   16697:         $tries ++;
                   16698:         my $captcha = Authen::Captcha->new (
                   16699:                                            output_folder => $captcha_params{'output_dir'},
                   16700:                                            data_folder   => $captcha_params{'db_dir'},
                   16701:                                           );
                   16702:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   16703: 
                   16704:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   16705:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   16706:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1176    raeburn  16707:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   16708:                       '<br />'.
                   16709:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  16710:             last;
                   16711:         }
                   16712:     }
                   16713:     return $output;
                   16714: }
                   16715: 
                   16716: sub captcha_settings {
                   16717:     my %captcha_params = (
                   16718:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   16719:                            www_output_dir => "/captchaspool",
                   16720:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   16721:                            numchars       => '5',
                   16722:                          );
                   16723:     return %captcha_params;
                   16724: }
                   16725: 
                   16726: sub check_captcha {
                   16727:     my ($captcha_chk,$captcha_error);
                   16728:     my $code = $env{'form.code'};
                   16729:     my $md5sum = $env{'form.crypt'};
                   16730:     my %captcha_params = &captcha_settings();
                   16731:     my $captcha = Authen::Captcha->new(
                   16732:                       output_folder => $captcha_params{'output_dir'},
                   16733:                       data_folder   => $captcha_params{'db_dir'},
                   16734:                   );
1.1109    raeburn  16735:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  16736:     my %captcha_hash = (
                   16737:                         0       => 'Code not checked (file error)',
                   16738:                        -1      => 'Failed: code expired',
                   16739:                        -2      => 'Failed: invalid code (not in database)',
                   16740:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   16741:     );
                   16742:     if ($captcha_chk != 1) {
                   16743:         $captcha_error = $captcha_hash{$captcha_chk}
                   16744:     }
                   16745:     return ($captcha_chk,$captcha_error);
                   16746: }
                   16747: 
                   16748: sub create_recaptcha {
1.1234    raeburn  16749:     my ($pubkey,$version) = @_;
                   16750:     if ($version >= 2) {
                   16751:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
                   16752:     } else {
                   16753:         my $use_ssl;
                   16754:         if ($ENV{'SERVER_PORT'} == 443) {
                   16755:             $use_ssl = 1;
                   16756:         }
                   16757:         my $captcha = Captcha::reCAPTCHA->new;
                   16758:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   16759:                $captcha->get_html($pubkey,undef,$use_ssl).
                   16760:                &mt('If the text is hard to read, [_1] will replace them.',
                   16761:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   16762:                '<br /><br />';
                   16763:     }
1.1094    raeburn  16764: }
                   16765: 
                   16766: sub check_recaptcha {
1.1234    raeburn  16767:     my ($privkey,$version) = @_;
1.1094    raeburn  16768:     my $captcha_chk;
1.1234    raeburn  16769:     if ($version >= 2) {
                   16770:         my $ua = LWP::UserAgent->new;
                   16771:         $ua->timeout(10);
                   16772:         my %info = (
                   16773:                      secret   => $privkey, 
                   16774:                      response => $env{'form.g-recaptcha-response'},
                   16775:                      remoteip => $ENV{'REMOTE_ADDR'},
                   16776:                    );
                   16777:         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
                   16778:         if ($response->is_success)  {
                   16779:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   16780:             if (ref($data) eq 'HASH') {
                   16781:                 if ($data->{'success'}) {
                   16782:                     $captcha_chk = 1;
                   16783:                 }
                   16784:             }
                   16785:         }
                   16786:     } else {
                   16787:         my $captcha = Captcha::reCAPTCHA->new;
                   16788:         my $captcha_result =
                   16789:             $captcha->check_answer(
                   16790:                                     $privkey,
                   16791:                                     $ENV{'REMOTE_ADDR'},
                   16792:                                     $env{'form.recaptcha_challenge_field'},
                   16793:                                     $env{'form.recaptcha_response_field'},
                   16794:                                   );
                   16795:         if ($captcha_result->{is_valid}) {
                   16796:             $captcha_chk = 1;
                   16797:         }
1.1094    raeburn  16798:     }
                   16799:     return $captcha_chk;
                   16800: }
                   16801: 
1.1174    raeburn  16802: sub emailusername_info {
1.1177    raeburn  16803:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174    raeburn  16804:     my %titles = &Apache::lonlocal::texthash (
                   16805:                      lastname      => 'Last Name',
                   16806:                      firstname     => 'First Name',
                   16807:                      institution   => 'School/college/university',
                   16808:                      location      => "School's city, state/province, country",
                   16809:                      web           => "School's web address",
                   16810:                      officialemail => 'E-mail address at institution (if different)',
                   16811:                  );
                   16812:     return (\@fields,\%titles);
                   16813: }
                   16814: 
1.1161    raeburn  16815: sub cleanup_html {
                   16816:     my ($incoming) = @_;
                   16817:     my $outgoing;
                   16818:     if ($incoming ne '') {
                   16819:         $outgoing = $incoming;
                   16820:         $outgoing =~ s/;/&#059;/g;
                   16821:         $outgoing =~ s/\#/&#035;/g;
                   16822:         $outgoing =~ s/\&/&#038;/g;
                   16823:         $outgoing =~ s/</&#060;/g;
                   16824:         $outgoing =~ s/>/&#062;/g;
                   16825:         $outgoing =~ s/\(/&#040/g;
                   16826:         $outgoing =~ s/\)/&#041;/g;
                   16827:         $outgoing =~ s/"/&#034;/g;
                   16828:         $outgoing =~ s/'/&#039;/g;
                   16829:         $outgoing =~ s/\$/&#036;/g;
                   16830:         $outgoing =~ s{/}{&#047;}g;
                   16831:         $outgoing =~ s/=/&#061;/g;
                   16832:         $outgoing =~ s/\\/&#092;/g
                   16833:     }
                   16834:     return $outgoing;
                   16835: }
                   16836: 
1.1190    musolffc 16837: # Checks for critical messages and returns a redirect url if one exists.
                   16838: # $interval indicates how often to check for messages.
                   16839: sub critical_redirect {
                   16840:     my ($interval) = @_;
                   16841:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   16842:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                   16843:                                         $env{'user.name'});
                   16844:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191    raeburn  16845:         my $redirecturl;
1.1190    musolffc 16846:         if ($what[0]) {
                   16847: 	    if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   16848: 	        $redirecturl='/adm/email?critical=display';
1.1191    raeburn  16849: 	        my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   16850:                 return (1, $url);
1.1190    musolffc 16851:             }
1.1191    raeburn  16852:         }
                   16853:     } 
                   16854:     return ();
1.1190    musolffc 16855: }
                   16856: 
1.1174    raeburn  16857: # Use:
                   16858: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   16859: #
                   16860: ##################################################
                   16861: #          password associated functions         #
                   16862: ##################################################
                   16863: sub des_keys {
                   16864:     # Make a new key for DES encryption.
                   16865:     # Each key has two parts which are returned separately.
                   16866:     # Please note:  Each key must be passed through the &hex function
                   16867:     # before it is output to the web browser.  The hex versions cannot
                   16868:     # be used to decrypt.
                   16869:     my @hexstr=('0','1','2','3','4','5','6','7',
                   16870:                 '8','9','a','b','c','d','e','f');
                   16871:     my $lkey='';
                   16872:     for (0..7) {
                   16873:         $lkey.=$hexstr[rand(15)];
                   16874:     }
                   16875:     my $ukey='';
                   16876:     for (0..7) {
                   16877:         $ukey.=$hexstr[rand(15)];
                   16878:     }
                   16879:     return ($lkey,$ukey);
                   16880: }
                   16881: 
                   16882: sub des_decrypt {
                   16883:     my ($key,$cyphertext) = @_;
                   16884:     my $keybin=pack("H16",$key);
                   16885:     my $cypher;
                   16886:     if ($Crypt::DES::VERSION>=2.03) {
                   16887:         $cypher=new Crypt::DES $keybin;
                   16888:     } else {
                   16889:         $cypher=new DES $keybin;
                   16890:     }
1.1233    raeburn  16891:     my $plaintext='';
                   16892:     my $cypherlength = length($cyphertext);
                   16893:     my $numchunks = int($cypherlength/32);
                   16894:     for (my $j=0; $j<$numchunks; $j++) {
                   16895:         my $start = $j*32;
                   16896:         my $cypherblock = substr($cyphertext,$start,32);
                   16897:         my $chunk =
                   16898:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   16899:         $chunk .=
                   16900:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   16901:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   16902:         $plaintext .= $chunk;
                   16903:     }
1.1174    raeburn  16904:     return $plaintext;
                   16905: }
                   16906: 
1.112     bowersj2 16907: 1;
                   16908: __END__;
1.41      ng       16909: 

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