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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1245  ! raeburn     4: # $Id: loncommon.pm,v 1.1244 2016/05/18 03:21:15 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.1182    raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    74: use DateTime::TimeZone;
1.1241    raeburn    75: use DateTime::Locale;
1.1220    raeburn    76: use Encode();
1.1091    foxr       77: use Text::Aspell;
1.1094    raeburn    78: use Authen::Captcha;
                     79: use Captcha::reCAPTCHA;
1.1234    raeburn    80: use JSON::DWIW;
                     81: use LWP::UserAgent;
1.1174    raeburn    82: use Crypt::DES;
                     83: use DynaLoader; # for Crypt::DES version
1.1223    musolffc   84: use MIME::Lite;
                     85: use MIME::Types;
1.117     www        86: 
1.517     raeburn    87: # ---------------------------------------------- Designs
                     88: use vars qw(%defaultdesign);
                     89: 
1.22      www        90: my $readit;
                     91: 
1.517     raeburn    92: 
1.157     matthew    93: ##
                     94: ## Global Variables
                     95: ##
1.46      matthew    96: 
1.643     foxr       97: 
                     98: # ----------------------------------------------- SSI with retries:
                     99: #
                    100: 
                    101: =pod
                    102: 
1.648     raeburn   103: =head1 Server Side include with retries:
1.643     foxr      104: 
                    105: =over 4
                    106: 
1.648     raeburn   107: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      108: 
                    109: Performs an ssi with some number of retries.  Retries continue either
                    110: until the result is ok or until the retry count supplied by the
                    111: caller is exhausted.  
                    112: 
                    113: Inputs:
1.648     raeburn   114: 
                    115: =over 4
                    116: 
1.643     foxr      117: resource   - Identifies the resource to insert.
1.648     raeburn   118: 
1.643     foxr      119: retries    - Count of the number of retries allowed.
1.648     raeburn   120: 
1.643     foxr      121: form       - Hash that identifies the rendering options.
                    122: 
1.648     raeburn   123: =back
                    124: 
                    125: Returns:
                    126: 
                    127: =over 4
                    128: 
1.643     foxr      129: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   130: 
1.643     foxr      131: response   - The response from the last attempt (which may or may not have been successful.
                    132: 
1.648     raeburn   133: =back
                    134: 
                    135: =back
                    136: 
1.643     foxr      137: =cut
                    138: 
                    139: sub ssi_with_retries {
                    140:     my ($resource, $retries, %form) = @_;
                    141: 
                    142: 
                    143:     my $ok = 0;			# True if we got a good response.
                    144:     my $content;
                    145:     my $response;
                    146: 
                    147:     # Try to get the ssi done. within the retries count:
                    148: 
                    149:     do {
                    150: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    151: 	$ok      = $response->is_success;
1.650     www       152:         if (!$ok) {
                    153:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    154:         }
1.643     foxr      155: 	$retries--;
                    156:     } while (!$ok && ($retries > 0));
                    157: 
                    158:     if (!$ok) {
                    159: 	$content = '';		# On error return an empty content.
                    160:     }
                    161:     return ($content, $response);
                    162: 
                    163: }
                    164: 
                    165: 
                    166: 
1.20      www       167: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  168: my %language;
1.124     www       169: my %supported_language;
1.1088    foxr      170: my %supported_codes;
1.1048    foxr      171: my %latex_language;		# For choosing hyphenation in <transl..>
                    172: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  173: my %cprtag;
1.192     taceyjo1  174: my %scprtag;
1.351     www       175: my %fe; my %fd; my %fm;
1.41      ng        176: my %category_extensions;
1.12      harris41  177: 
1.46      matthew   178: # ---------------------------------------------- Thesaurus variables
1.144     matthew   179: #
                    180: # %Keywords:
                    181: #      A hash used by &keyword to determine if a word is considered a keyword.
                    182: # $thesaurus_db_file 
                    183: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   184: 
                    185: my %Keywords;
                    186: my $thesaurus_db_file;
                    187: 
1.144     matthew   188: #
                    189: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    190: # thesaurus.tab, and filecategories.tab.
                    191: #
1.18      www       192: BEGIN {
1.46      matthew   193:     # Variable initialization
                    194:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    195:     #
1.22      www       196:     unless ($readit) {
1.12      harris41  197: # ------------------------------------------------------------------- languages
                    198:     {
1.158     raeburn   199:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    200:                                    '/language.tab';
                    201:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  202:             while (my $line = <$fh>) {
                    203:                 next if ($line=~/^\#/);
                    204:                 chomp($line);
1.1088    foxr      205:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   206:                 $language{$key}=$val.' - '.$enc;
                    207:                 if ($sup) {
                    208:                     $supported_language{$key}=$sup;
1.1088    foxr      209: 		    $supported_codes{$key}   = $code;
1.158     raeburn   210:                 }
1.1048    foxr      211: 		if ($latex) {
                    212: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      213: 		    $latex_language{$code} = $latex;
1.1048    foxr      214: 		}
1.158     raeburn   215:             }
                    216:             close($fh);
                    217:         }
1.12      harris41  218:     }
                    219: # ------------------------------------------------------------------ copyrights
                    220:     {
1.158     raeburn   221:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    222:                                   '/copyright.tab';
                    223:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  224:             while (my $line = <$fh>) {
                    225:                 next if ($line=~/^\#/);
                    226:                 chomp($line);
                    227:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   228:                 $cprtag{$key}=$val;
                    229:             }
                    230:             close($fh);
                    231:         }
1.12      harris41  232:     }
1.351     www       233: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  234:     {
                    235:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    236:                                   '/source_copyright.tab';
                    237:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  238:             while (my $line = <$fh>) {
                    239:                 next if ($line =~ /^\#/);
                    240:                 chomp($line);
                    241:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  242:                 $scprtag{$key}=$val;
                    243:             }
                    244:             close($fh);
                    245:         }
                    246:     }
1.63      www       247: 
1.517     raeburn   248: # -------------------------------------------------------------- default domain designs
1.63      www       249:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   250:     my $designfile = $designdir.'/default.tab';
                    251:     if ( open (my $fh,"<$designfile") ) {
                    252:         while (my $line = <$fh>) {
                    253:             next if ($line =~ /^\#/);
                    254:             chomp($line);
                    255:             my ($key,$val)=(split(/\=/,$line));
                    256:             if ($val) { $defaultdesign{$key}=$val; }
                    257:         }
                    258:         close($fh);
1.63      www       259:     }
                    260: 
1.15      harris41  261: # ------------------------------------------------------------- file categories
                    262:     {
1.158     raeburn   263:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    264:                                   '/filecategories.tab';
                    265:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  266: 	    while (my $line = <$fh>) {
                    267: 		next if ($line =~ /^\#/);
                    268: 		chomp($line);
                    269:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   270:                 push @{$category_extensions{lc($category)}},$extension;
                    271:             }
                    272:             close($fh);
                    273:         }
                    274: 
1.15      harris41  275:     }
1.12      harris41  276: # ------------------------------------------------------------------ file types
                    277:     {
1.158     raeburn   278:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    279:                '/filetypes.tab';
                    280:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  281:             while (my $line = <$fh>) {
                    282: 		next if ($line =~ /^\#/);
                    283: 		chomp($line);
                    284:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   285:                 if ($descr ne '') {
                    286:                     $fe{$ending}=lc($emb);
                    287:                     $fd{$ending}=$descr;
1.351     www       288:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   289:                 }
                    290:             }
                    291:             close($fh);
                    292:         }
1.12      harris41  293:     }
1.22      www       294:     &Apache::lonnet::logthis(
1.705     tempelho  295:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       296:     $readit=1;
1.46      matthew   297:     }  # end of unless($readit) 
1.32      matthew   298:     
                    299: }
1.112     bowersj2  300: 
1.42      matthew   301: ###############################################################
                    302: ##           HTML and Javascript Helper Functions            ##
                    303: ###############################################################
                    304: 
                    305: =pod 
                    306: 
1.112     bowersj2  307: =head1 HTML and Javascript Functions
1.42      matthew   308: 
1.112     bowersj2  309: =over 4
                    310: 
1.648     raeburn   311: =item * &browser_and_searcher_javascript()
1.112     bowersj2  312: 
                    313: X<browsing, javascript>X<searching, javascript>Returns a string
                    314: containing javascript with two functions, C<openbrowser> and
                    315: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    316: tags.
1.42      matthew   317: 
1.648     raeburn   318: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   319: 
                    320: inputs: formname, elementname, only, omit
                    321: 
                    322: formname and elementname indicate the name of the html form and name of
                    323: the element that the results of the browsing selection are to be placed in. 
                    324: 
                    325: Specifying 'only' will restrict the browser to displaying only files
1.185     www       326: with the given extension.  Can be a comma separated list.
1.42      matthew   327: 
                    328: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       329: with the given extension.  Can be a comma separated list.
1.42      matthew   330: 
1.648     raeburn   331: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   332: 
                    333: Inputs: formname, elementname
                    334: 
                    335: formname and elementname specify the name of the html form and the name
                    336: of the element the selection from the search results will be placed in.
1.542     raeburn   337: 
1.42      matthew   338: =cut
                    339: 
                    340: sub browser_and_searcher_javascript {
1.199     albertel  341:     my ($mode)=@_;
                    342:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  343:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   344:     return <<END;
1.219     albertel  345: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   346:     var editbrowser = null;
1.135     albertel  347:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       348:         var url = '$resurl/?';
1.42      matthew   349:         if (editbrowser == null) {
                    350:             url += 'launch=1&';
                    351:         }
                    352:         url += 'catalogmode=interactive&';
1.199     albertel  353:         url += 'mode=$mode&';
1.611     albertel  354:         url += 'inhibitmenu=yes&';
1.42      matthew   355:         url += 'form=' + formname + '&';
                    356:         if (only != null) {
                    357:             url += 'only=' + only + '&';
1.217     albertel  358:         } else {
                    359:             url += 'only=&';
                    360: 	}
1.42      matthew   361:         if (omit != null) {
                    362:             url += 'omit=' + omit + '&';
1.217     albertel  363:         } else {
                    364:             url += 'omit=&';
                    365: 	}
1.135     albertel  366:         if (titleelement != null) {
                    367:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  368:         } else {
                    369: 	    url += 'titleelement=&';
                    370: 	}
1.42      matthew   371:         url += 'element=' + elementname + '';
                    372:         var title = 'Browser';
1.435     albertel  373:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   374:         options += ',width=700,height=600';
                    375:         editbrowser = open(url,title,options,'1');
                    376:         editbrowser.focus();
                    377:     }
                    378:     var editsearcher;
1.135     albertel  379:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   380:         var url = '/adm/searchcat?';
                    381:         if (editsearcher == null) {
                    382:             url += 'launch=1&';
                    383:         }
                    384:         url += 'catalogmode=interactive&';
1.199     albertel  385:         url += 'mode=$mode&';
1.42      matthew   386:         url += 'form=' + formname + '&';
1.135     albertel  387:         if (titleelement != null) {
                    388:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  389:         } else {
                    390: 	    url += 'titleelement=&';
                    391: 	}
1.42      matthew   392:         url += 'element=' + elementname + '';
                    393:         var title = 'Search';
1.435     albertel  394:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   395:         options += ',width=700,height=600';
                    396:         editsearcher = open(url,title,options,'1');
                    397:         editsearcher.focus();
                    398:     }
1.219     albertel  399: // END LON-CAPA Internal -->
1.42      matthew   400: END
1.170     www       401: }
                    402: 
                    403: sub lastresurl {
1.258     albertel  404:     if ($env{'environment.lastresurl'}) {
                    405: 	return $env{'environment.lastresurl'}
1.170     www       406:     } else {
                    407: 	return '/res';
                    408:     }
                    409: }
                    410: 
                    411: sub storeresurl {
                    412:     my $resurl=&Apache::lonnet::clutter(shift);
                    413:     unless ($resurl=~/^\/res/) { return 0; }
                    414:     $resurl=~s/\/$//;
                    415:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   416:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       417:     return 1;
1.42      matthew   418: }
                    419: 
1.74      www       420: sub studentbrowser_javascript {
1.111     www       421:    unless (
1.258     albertel  422:             (($env{'request.course.id'}) && 
1.302     albertel  423:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    424: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    425: 					  '/'.$env{'request.course.sec'})
                    426: 	      ))
1.258     albertel  427:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       428:           ) { return ''; }  
1.74      www       429:    return (<<'ENDSTDBRW');
1.776     bisitz    430: <script type="text/javascript" language="Javascript">
1.824     bisitz    431: // <![CDATA[
1.74      www       432:     var stdeditbrowser;
1.999     www       433:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       434:         var url = '/adm/pickstudent?';
                    435:         var filter;
1.558     albertel  436: 	if (!ignorefilter) {
                    437: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    438: 	}
1.74      www       439:         if (filter != null) {
                    440:            if (filter != '') {
                    441:                url += 'filter='+filter+'&';
                    442: 	   }
                    443:         }
                    444:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       445:                                     '&udomelement='+udom+
                    446:                                     '&clicker='+clicker;
1.111     www       447: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   448:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       449:         var title = 'Student_Browser';
1.74      www       450:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    451:         options += ',width=700,height=600';
                    452:         stdeditbrowser = open(url,title,options,'1');
                    453:         stdeditbrowser.focus();
                    454:     }
1.824     bisitz    455: // ]]>
1.74      www       456: </script>
                    457: ENDSTDBRW
                    458: }
1.42      matthew   459: 
1.1003    www       460: sub resourcebrowser_javascript {
                    461:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       462:    return (<<'ENDRESBRW');
1.1003    www       463: <script type="text/javascript" language="Javascript">
                    464: // <![CDATA[
                    465:     var reseditbrowser;
1.1004    www       466:     function openresbrowser(formname,reslink) {
1.1005    www       467:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       468:         var title = 'Resource_Browser';
                    469:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       470:         options += ',width=700,height=500';
1.1004    www       471:         reseditbrowser = open(url,title,options,'1');
                    472:         reseditbrowser.focus();
1.1003    www       473:     }
                    474: // ]]>
                    475: </script>
1.1004    www       476: ENDRESBRW
1.1003    www       477: }
                    478: 
1.74      www       479: sub selectstudent_link {
1.999     www       480:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    481:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    482:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    483:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  484:    if ($env{'request.course.id'}) {  
1.302     albertel  485:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    486: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    487: 					'/'.$env{'request.course.sec'})) {
1.111     www       488: 	   return '';
                    489:        }
1.999     www       490:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   491:        if ($courseadvonly)  {
                    492:            $callargs .= ",'',1,1";
                    493:        }
                    494:        return '<span class="LC_nobreak">'.
                    495:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    496:               &mt('Select User').'</a></span>';
1.74      www       497:    }
1.258     albertel  498:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       499:        $callargs .= ",'',1"; 
1.793     raeburn   500:        return '<span class="LC_nobreak">'.
                    501:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    502:               &mt('Select User').'</a></span>';
1.111     www       503:    }
                    504:    return '';
1.91      www       505: }
                    506: 
1.1004    www       507: sub selectresource_link {
                    508:    my ($form,$reslink,$arg)=@_;
                    509:    
                    510:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    511:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    512:    unless ($env{'request.course.id'}) { return $arg; }
                    513:    return '<span class="LC_nobreak">'.
                    514:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    515:               $arg.'</a></span>';
                    516: }
                    517: 
                    518: 
                    519: 
1.653     raeburn   520: sub authorbrowser_javascript {
                    521:     return <<"ENDAUTHORBRW";
1.776     bisitz    522: <script type="text/javascript" language="JavaScript">
1.824     bisitz    523: // <![CDATA[
1.653     raeburn   524: var stdeditbrowser;
                    525: 
                    526: function openauthorbrowser(formname,udom) {
                    527:     var url = '/adm/pickauthor?';
                    528:     url += 'form='+formname+'&roledom='+udom;
                    529:     var title = 'Author_Browser';
                    530:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    531:     options += ',width=700,height=600';
                    532:     stdeditbrowser = open(url,title,options,'1');
                    533:     stdeditbrowser.focus();
                    534: }
                    535: 
1.824     bisitz    536: // ]]>
1.653     raeburn   537: </script>
                    538: ENDAUTHORBRW
                    539: }
                    540: 
1.91      www       541: sub coursebrowser_javascript {
1.1116    raeburn   542:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221    raeburn   543:         $credits_element,$instcode) = @_;
1.932     raeburn   544:     my $wintitle = 'Course_Browser';
1.931     raeburn   545:     if ($crstype eq 'Community') {
1.932     raeburn   546:         $wintitle = 'Community_Browser';
1.909     raeburn   547:     }
1.876     raeburn   548:     my $id_functions = &javascript_index_functions();
                    549:     my $output = '
1.776     bisitz    550: <script type="text/javascript" language="JavaScript">
1.824     bisitz    551: // <![CDATA[
1.468     raeburn   552:     var stdeditbrowser;'."\n";
1.876     raeburn   553: 
                    554:     $output .= <<"ENDSTDBRW";
1.909     raeburn   555:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       556:         var url = '/adm/pickcourse?';
1.895     raeburn   557:         var formid = getFormIdByName(formname);
1.876     raeburn   558:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  559:         if (domainfilter != null) {
                    560:            if (domainfilter != '') {
                    561:                url += 'domainfilter='+domainfilter+'&';
                    562: 	   }
                    563:         }
1.91      www       564:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  565: 	                            '&cdomelement='+udom+
                    566:                                     '&cnameelement='+desc;
1.468     raeburn   567:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   568:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   569:                 url += '&roleelement='+extra_element;
                    570:                 if (domainfilter == null || domainfilter == '') {
                    571:                     url += '&domainfilter='+extra_element;
                    572:                 }
1.234     raeburn   573:             }
1.468     raeburn   574:             else {
                    575:                 if (formname == 'portform') {
                    576:                     url += '&setroles='+extra_element;
1.800     raeburn   577:                 } else {
                    578:                     if (formname == 'rules') {
                    579:                         url += '&fixeddom='+extra_element; 
                    580:                     }
1.468     raeburn   581:                 }
                    582:             }     
1.230     raeburn   583:         }
1.909     raeburn   584:         if (type != null && type != '') {
                    585:             url += '&type='+type;
                    586:         }
                    587:         if (type_elem != null && type_elem != '') {
                    588:             url += '&typeelement='+type_elem;
                    589:         }
1.872     raeburn   590:         if (formname == 'ccrs') {
                    591:             var ownername = document.forms[formid].ccuname.value;
                    592:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238    raeburn   593:             url += '&cloner='+ownername+':'+ownerdom;
                    594:             if (type == 'Course') {
                    595:                 url += '&crscode='+document.forms[formid].crscode.value;
                    596:             }
1.1221    raeburn   597:         }
                    598:         if (formname == 'requestcrs') {
                    599:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   600:         }
1.293     raeburn   601:         if (multflag !=null && multflag != '') {
                    602:             url += '&multiple='+multflag;
                    603:         }
1.909     raeburn   604:         var title = '$wintitle';
1.91      www       605:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    606:         options += ',width=700,height=600';
                    607:         stdeditbrowser = open(url,title,options,'1');
                    608:         stdeditbrowser.focus();
                    609:     }
1.876     raeburn   610: $id_functions
                    611: ENDSTDBRW
1.1116    raeburn   612:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    613:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    614:                                       $credits_element);
1.876     raeburn   615:     }
                    616:     $output .= '
                    617: // ]]>
                    618: </script>';
                    619:     return $output;
                    620: }
                    621: 
                    622: sub javascript_index_functions {
                    623:     return <<"ENDJS";
                    624: 
                    625: function getFormIdByName(formname) {
                    626:     for (var i=0;i<document.forms.length;i++) {
                    627:         if (document.forms[i].name == formname) {
                    628:             return i;
                    629:         }
                    630:     }
                    631:     return -1;
                    632: }
                    633: 
                    634: function getIndexByName(formid,item) {
                    635:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    636:         if (document.forms[formid].elements[i].name == item) {
                    637:             return i;
                    638:         }
                    639:     }
                    640:     return -1;
                    641: }
1.468     raeburn   642: 
1.876     raeburn   643: function getDomainFromSelectbox(formname,udom) {
                    644:     var userdom;
                    645:     var formid = getFormIdByName(formname);
                    646:     if (formid > -1) {
                    647:         var domid = getIndexByName(formid,udom);
                    648:         if (domid > -1) {
                    649:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    650:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    651:             }
                    652:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    653:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   654:             }
                    655:         }
                    656:     }
1.876     raeburn   657:     return userdom;
                    658: }
                    659: 
                    660: ENDJS
1.468     raeburn   661: 
1.876     raeburn   662: }
                    663: 
1.1017    raeburn   664: sub javascript_array_indexof {
1.1018    raeburn   665:     return <<ENDJS;
1.1017    raeburn   666: <script type="text/javascript" language="JavaScript">
                    667: // <![CDATA[
                    668: 
                    669: if (!Array.prototype.indexOf) {
                    670:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    671:         "use strict";
                    672:         if (this === void 0 || this === null) {
                    673:             throw new TypeError();
                    674:         }
                    675:         var t = Object(this);
                    676:         var len = t.length >>> 0;
                    677:         if (len === 0) {
                    678:             return -1;
                    679:         }
                    680:         var n = 0;
                    681:         if (arguments.length > 0) {
                    682:             n = Number(arguments[1]);
1.1088    foxr      683:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   684:                 n = 0;
                    685:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    686:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    687:             }
                    688:         }
                    689:         if (n >= len) {
                    690:             return -1;
                    691:         }
                    692:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    693:         for (; k < len; k++) {
                    694:             if (k in t && t[k] === searchElement) {
                    695:                 return k;
                    696:             }
                    697:         }
                    698:         return -1;
                    699:     }
                    700: }
                    701: 
                    702: // ]]>
                    703: </script>
                    704: 
                    705: ENDJS
                    706: 
                    707: }
                    708: 
1.876     raeburn   709: sub userbrowser_javascript {
                    710:     my $id_functions = &javascript_index_functions();
                    711:     return <<"ENDUSERBRW";
                    712: 
1.888     raeburn   713: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   714:     var url = '/adm/pickuser?';
                    715:     var userdom = getDomainFromSelectbox(formname,udom);
                    716:     if (userdom != null) {
                    717:        if (userdom != '') {
                    718:            url += 'srchdom='+userdom+'&';
                    719:        }
                    720:     }
                    721:     url += 'form=' + formname + '&unameelement='+uname+
                    722:                                 '&udomelement='+udom+
                    723:                                 '&ulastelement='+ulast+
                    724:                                 '&ufirstelement='+ufirst+
                    725:                                 '&uemailelement='+uemail+
1.881     raeburn   726:                                 '&hideudomelement='+hideudom+
                    727:                                 '&coursedom='+crsdom;
1.888     raeburn   728:     if ((caller != null) && (caller != undefined)) {
                    729:         url += '&caller='+caller;
                    730:     }
1.876     raeburn   731:     var title = 'User_Browser';
                    732:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    733:     options += ',width=700,height=600';
                    734:     var stdeditbrowser = open(url,title,options,'1');
                    735:     stdeditbrowser.focus();
                    736: }
                    737: 
1.888     raeburn   738: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   739:     var formid = getFormIdByName(formname);
                    740:     if (formid > -1) {
1.888     raeburn   741:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   742:         var domid = getIndexByName(formid,udom);
                    743:         var hidedomid = getIndexByName(formid,origdom);
                    744:         if (hidedomid > -1) {
                    745:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   746:             var unameval = document.forms[formid].elements[unameid].value;
                    747:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    748:                 if (domid > -1) {
                    749:                     var slct = document.forms[formid].elements[domid];
                    750:                     if (slct.type == 'select-one') {
                    751:                         var i;
                    752:                         for (i=0;i<slct.length;i++) {
                    753:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    754:                         }
                    755:                     }
                    756:                     if (slct.type == 'hidden') {
                    757:                         slct.value = fixeddom;
1.876     raeburn   758:                     }
                    759:                 }
1.468     raeburn   760:             }
                    761:         }
                    762:     }
1.876     raeburn   763:     return;
                    764: }
                    765: 
                    766: $id_functions
                    767: ENDUSERBRW
1.468     raeburn   768: }
                    769: 
                    770: sub setsec_javascript {
1.1116    raeburn   771:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   772:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    773:         $communityrolestr);
                    774:     if ($role_element ne '') {
                    775:         my @allroles = ('st','ta','ep','in','ad');
                    776:         foreach my $crstype ('Course','Community') {
                    777:             if ($crstype eq 'Community') {
                    778:                 foreach my $role (@allroles) {
                    779:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    780:                 }
                    781:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    782:             } else {
                    783:                 foreach my $role (@allroles) {
                    784:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    785:                 }
                    786:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    787:             }
                    788:         }
                    789:         $rolestr = '"'.join('","',@allroles).'"';
                    790:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    791:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    792:     }
1.468     raeburn   793:     my $setsections = qq|
                    794: function setSect(sectionlist) {
1.629     raeburn   795:     var sectionsArray = new Array();
                    796:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    797:         sectionsArray = sectionlist.split(",");
                    798:     }
1.468     raeburn   799:     var numSections = sectionsArray.length;
                    800:     document.$formname.$sec_element.length = 0;
                    801:     if (numSections == 0) {
                    802:         document.$formname.$sec_element.multiple=false;
                    803:         document.$formname.$sec_element.size=1;
                    804:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    805:     } else {
                    806:         if (numSections == 1) {
                    807:             document.$formname.$sec_element.multiple=false;
                    808:             document.$formname.$sec_element.size=1;
                    809:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    810:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    811:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    812:         } else {
                    813:             for (var i=0; i<numSections; i++) {
                    814:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    815:             }
                    816:             document.$formname.$sec_element.multiple=true
                    817:             if (numSections < 3) {
                    818:                 document.$formname.$sec_element.size=numSections;
                    819:             } else {
                    820:                 document.$formname.$sec_element.size=3;
                    821:             }
                    822:             document.$formname.$sec_element.options[0].selected = false
                    823:         }
                    824:     }
1.91      www       825: }
1.905     raeburn   826: 
                    827: function setRole(crstype) {
1.468     raeburn   828: |;
1.905     raeburn   829:     if ($role_element eq '') {
                    830:         $setsections .= '    return;
                    831: }
                    832: ';
                    833:     } else {
                    834:         $setsections .= qq|
                    835:     var elementLength = document.$formname.$role_element.length;
                    836:     var allroles = Array($rolestr);
                    837:     var courserolenames = Array($courserolestr);
                    838:     var communityrolenames = Array($communityrolestr);
                    839:     if (elementLength != undefined) {
                    840:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    841:             if (crstype == 'Course') {
                    842:                 return;
                    843:             } else {
                    844:                 allroles[5] = 'co';
                    845:                 for (var i=0; i<6; i++) {
                    846:                     document.$formname.$role_element.options[i].value = allroles[i];
                    847:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    848:                 }
                    849:             }
                    850:         } else {
                    851:             if (crstype == 'Community') {
                    852:                 return;
                    853:             } else {
                    854:                 allroles[5] = 'cc';
                    855:                 for (var i=0; i<6; i++) {
                    856:                     document.$formname.$role_element.options[i].value = allroles[i];
                    857:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    858:                 }
                    859:             }
                    860:         }
                    861:     }
                    862:     return;
                    863: }
                    864: |;
                    865:     }
1.1116    raeburn   866:     if ($credits_element) {
                    867:         $setsections .= qq|
                    868: function setCredits(defaultcredits) {
                    869:     document.$formname.$credits_element.value = defaultcredits;
                    870:     return;
                    871: }
                    872: |;
                    873:     }
1.468     raeburn   874:     return $setsections;
                    875: }
                    876: 
1.91      www       877: sub selectcourse_link {
1.909     raeburn   878:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    879:        $typeelement) = @_;
                    880:    my $type = $selecttype;
1.871     raeburn   881:    my $linktext = &mt('Select Course');
                    882:    if ($selecttype eq 'Community') {
1.909     raeburn   883:        $linktext = &mt('Select Community');
1.1239    raeburn   884:    } elsif ($selecttype eq 'Placement') {
                    885:        $linktext = &mt('Select Placement Test'); 
1.906     raeburn   886:    } elsif ($selecttype eq 'Course/Community') {
                    887:        $linktext = &mt('Select Course/Community');
1.909     raeburn   888:        $type = '';
1.1019    raeburn   889:    } elsif ($selecttype eq 'Select') {
                    890:        $linktext = &mt('Select');
                    891:        $type = '';
1.871     raeburn   892:    }
1.787     bisitz    893:    return '<span class="LC_nobreak">'
                    894:          ."<a href='"
                    895:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    896:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   897:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   898:          ."'>".$linktext.'</a>'
1.787     bisitz    899:          .'</span>';
1.74      www       900: }
1.42      matthew   901: 
1.653     raeburn   902: sub selectauthor_link {
                    903:    my ($form,$udom)=@_;
                    904:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    905:           &mt('Select Author').'</a>';
                    906: }
                    907: 
1.876     raeburn   908: sub selectuser_link {
1.881     raeburn   909:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   910:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   911:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   912:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   913:            ');">'.$linktext.'</a>';
1.876     raeburn   914: }
                    915: 
1.273     raeburn   916: sub check_uncheck_jscript {
                    917:     my $jscript = <<"ENDSCRT";
                    918: function checkAll(field) {
                    919:     if (field.length > 0) {
                    920:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   921:             if (!field[i].disabled) { 
                    922:                 field[i].checked = true;
                    923:             }
1.273     raeburn   924:         }
                    925:     } else {
1.1093    raeburn   926:         if (!field.disabled) { 
                    927:             field.checked = true;
                    928:         }
1.273     raeburn   929:     }
                    930: }
                    931:  
                    932: function uncheckAll(field) {
                    933:     if (field.length > 0) {
                    934:         for (i = 0; i < field.length; i++) {
                    935:             field[i].checked = false ;
1.543     albertel  936:         }
                    937:     } else {
1.273     raeburn   938:         field.checked = false ;
                    939:     }
                    940: }
                    941: ENDSCRT
                    942:     return $jscript;
                    943: }
                    944: 
1.656     www       945: sub select_timezone {
1.659     raeburn   946:    my ($name,$selected,$onchange,$includeempty)=@_;
                    947:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    948:    if ($includeempty) {
                    949:        $output .= '<option value=""';
                    950:        if (($selected eq '') || ($selected eq 'local')) {
                    951:            $output .= ' selected="selected" ';
                    952:        }
                    953:        $output .= '> </option>';
                    954:    }
1.657     raeburn   955:    my @timezones = DateTime::TimeZone->all_names;
                    956:    foreach my $tzone (@timezones) {
                    957:        $output.= '<option value="'.$tzone.'"';
                    958:        if ($tzone eq $selected) {
                    959:            $output.=' selected="selected"';
                    960:        }
                    961:        $output.=">$tzone</option>\n";
1.656     www       962:    }
                    963:    $output.="</select>";
                    964:    return $output;
                    965: }
1.273     raeburn   966: 
1.687     raeburn   967: sub select_datelocale {
                    968:     my ($name,$selected,$onchange,$includeempty)=@_;
                    969:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    970:     if ($includeempty) {
                    971:         $output .= '<option value=""';
                    972:         if ($selected eq '') {
                    973:             $output .= ' selected="selected" ';
                    974:         }
                    975:         $output .= '> </option>';
                    976:     }
1.1241    raeburn   977:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   978:     my (@possibles,%locale_names);
1.1241    raeburn   979:     my @locales = DateTime::Locale->ids();
                    980:     foreach my $id (@locales) {
                    981:         if ($id ne '') {
                    982:             my ($en_terr,$native_terr);
                    983:             my $loc = DateTime::Locale->load($id);
                    984:             if (ref($loc)) {
                    985:                 $en_terr = $loc->name();
                    986:                 $native_terr = $loc->native_name();
1.687     raeburn   987:                 if (grep(/^en$/,@languages) || !@languages) {
                    988:                     if ($en_terr ne '') {
                    989:                         $locale_names{$id} = '('.$en_terr.')';
                    990:                     } elsif ($native_terr ne '') {
                    991:                         $locale_names{$id} = $native_terr;
                    992:                     }
                    993:                 } else {
                    994:                     if ($native_terr ne '') {
                    995:                         $locale_names{$id} = $native_terr.' ';
                    996:                     } elsif ($en_terr ne '') {
                    997:                         $locale_names{$id} = '('.$en_terr.')';
                    998:                     }
                    999:                 }
1.1220    raeburn  1000:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241    raeburn  1001:                 push(@possibles,$id);
                   1002:             } 
1.687     raeburn  1003:         }
                   1004:     }
                   1005:     foreach my $item (sort(@possibles)) {
                   1006:         $output.= '<option value="'.$item.'"';
                   1007:         if ($item eq $selected) {
                   1008:             $output.=' selected="selected"';
                   1009:         }
                   1010:         $output.=">$item";
                   1011:         if ($locale_names{$item} ne '') {
1.1220    raeburn  1012:             $output.='  '.$locale_names{$item};
1.687     raeburn  1013:         }
                   1014:         $output.="</option>\n";
                   1015:     }
                   1016:     $output.="</select>";
                   1017:     return $output;
                   1018: }
                   1019: 
1.792     raeburn  1020: sub select_language {
                   1021:     my ($name,$selected,$includeempty) = @_;
                   1022:     my %langchoices;
                   1023:     if ($includeempty) {
1.1117    raeburn  1024:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1025:     }
                   1026:     foreach my $id (&languageids()) {
                   1027:         my $code = &supportedlanguagecode($id);
                   1028:         if ($code) {
                   1029:             $langchoices{$code} = &plainlanguagedescription($id);
                   1030:         }
                   1031:     }
1.1117    raeburn  1032:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1033:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1034: }
                   1035: 
1.42      matthew  1036: =pod
1.36      matthew  1037: 
1.1088    foxr     1038: 
                   1039: =item * &list_languages()
                   1040: 
                   1041: Returns an array reference that is suitable for use in language prompters.
                   1042: Each array element is itself a two element array.  The first element
                   1043: is the language code.  The second element a descsriptiuon of the 
                   1044: language itself.  This is suitable for use in e.g.
                   1045: &Apache::edit::select_arg (once dereferenced that is).
                   1046: 
                   1047: =cut 
                   1048: 
                   1049: sub list_languages {
                   1050:     my @lang_choices;
                   1051: 
                   1052:     foreach my $id (&languageids()) {
                   1053: 	my $code = &supportedlanguagecode($id);
                   1054: 	if ($code) {
                   1055: 	    my $selector    = $supported_codes{$id};
                   1056: 	    my $description = &plainlanguagedescription($id);
                   1057: 	    push (@lang_choices, [$selector, $description]);
                   1058: 	}
                   1059:     }
                   1060:     return \@lang_choices;
                   1061: }
                   1062: 
                   1063: =pod
                   1064: 
1.648     raeburn  1065: =item * &linked_select_forms(...)
1.36      matthew  1066: 
                   1067: linked_select_forms returns a string containing a <script></script> block
                   1068: and html for two <select> menus.  The select menus will be linked in that
                   1069: changing the value of the first menu will result in new values being placed
                   1070: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1071: order unless a defined order is provided.
1.36      matthew  1072: 
                   1073: linked_select_forms takes the following ordered inputs:
                   1074: 
                   1075: =over 4
                   1076: 
1.112     bowersj2 1077: =item * $formname, the name of the <form> tag
1.36      matthew  1078: 
1.112     bowersj2 1079: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1080: 
1.112     bowersj2 1081: =item * $firstdefault, the default value for the first menu
1.36      matthew  1082: 
1.112     bowersj2 1083: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1084: 
1.112     bowersj2 1085: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1086: 
1.112     bowersj2 1087: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1088: 
1.609     raeburn  1089: =item * $menuorder, the order of values in the first menu
                   1090: 
1.1115    raeburn  1091: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1092:         event for the first <select> tag
                   1093: 
                   1094: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1095:         event for the second <select> tag
                   1096: 
1.1245  ! raeburn  1097: =item * $suffix, to differentiate separate uses of select2data javascript
        !          1098:         objects in a page.
        !          1099: 
1.41      ng       1100: =back 
                   1101: 
1.36      matthew  1102: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1103: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1104: values for the first select menu.  The text that coincides with the 
1.41      ng       1105: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1106: and text for the second menu are given in the hash pointed to by 
                   1107: $menu{$choice1}->{'select2'}.  
                   1108: 
1.112     bowersj2 1109:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1110:                        default => "B3",
                   1111:                        select2 => { 
                   1112:                            B1 => "Choice B1",
                   1113:                            B2 => "Choice B2",
                   1114:                            B3 => "Choice B3",
                   1115:                            B4 => "Choice B4"
1.609     raeburn  1116:                            },
                   1117:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1118:                    },
                   1119:                A2 => { text =>"Choice A2" ,
                   1120:                        default => "C2",
                   1121:                        select2 => { 
                   1122:                            C1 => "Choice C1",
                   1123:                            C2 => "Choice C2",
                   1124:                            C3 => "Choice C3"
1.609     raeburn  1125:                            },
                   1126:                        order => ['C2','C1','C3'],
1.112     bowersj2 1127:                    },
                   1128:                A3 => { text =>"Choice A3" ,
                   1129:                        default => "D6",
                   1130:                        select2 => { 
                   1131:                            D1 => "Choice D1",
                   1132:                            D2 => "Choice D2",
                   1133:                            D3 => "Choice D3",
                   1134:                            D4 => "Choice D4",
                   1135:                            D5 => "Choice D5",
                   1136:                            D6 => "Choice D6",
                   1137:                            D7 => "Choice D7"
1.609     raeburn  1138:                            },
                   1139:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1140:                    }
                   1141:                );
1.36      matthew  1142: 
                   1143: =cut
                   1144: 
                   1145: sub linked_select_forms {
                   1146:     my ($formname,
                   1147:         $middletext,
                   1148:         $firstdefault,
                   1149:         $firstselectname,
                   1150:         $secondselectname, 
1.609     raeburn  1151:         $hashref,
                   1152:         $menuorder,
1.1115    raeburn  1153:         $onchangefirst,
1.1245  ! raeburn  1154:         $onchangesecond,
        !          1155:         $suffix
1.36      matthew  1156:         ) = @_;
                   1157:     my $second = "document.$formname.$secondselectname";
                   1158:     my $first = "document.$formname.$firstselectname";
                   1159:     # output the javascript to do the changing
                   1160:     my $result = '';
1.776     bisitz   1161:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1162:     $result.="// <![CDATA[\n";
1.1245  ! raeburn  1163:     $result.="var select2data${suffix} = new Object();\n";
1.36      matthew  1164:     $" = '","';
                   1165:     my $debug = '';
                   1166:     foreach my $s1 (sort(keys(%$hashref))) {
1.1245  ! raeburn  1167:         $result.="select2data${suffix}['d_$s1'] = new Object();\n";        
        !          1168:         $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36      matthew  1169:             $hashref->{$s1}->{'default'}."');\n";
1.1245  ! raeburn  1170:         $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36      matthew  1171:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1172:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1173:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1174:         }
1.36      matthew  1175:         $result.="\"@s2values\");\n";
1.1245  ! raeburn  1176:         $result.="select2data${suffix}['d_$s1'].texts = new Array(";        
1.36      matthew  1177:         my @s2texts;
                   1178:         foreach my $value (@s2values) {
                   1179:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1180:         }
                   1181:         $result.="\"@s2texts\");\n";
                   1182:     }
                   1183:     $"=' ';
                   1184:     $result.= <<"END";
                   1185: 
1.1245  ! raeburn  1186: function select1${suffix}_changed() {
1.36      matthew  1187:     // Determine new choice
1.1245  ! raeburn  1188:     var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36      matthew  1189:     // update select2
1.1245  ! raeburn  1190:     var values     = select2data${suffix}[newvalue].values;
        !          1191:     var texts      = select2data${suffix}[newvalue].texts;
        !          1192:     var select2def = select2data${suffix}[newvalue].def;
1.36      matthew  1193:     var i;
                   1194:     // out with the old
1.1245  ! raeburn  1195:     $second.options.length = 0;
        !          1196:     // in with the new
1.36      matthew  1197:     for (i=0;i<values.length; i++) {
                   1198:         $second.options[i] = new Option(values[i]);
1.143     matthew  1199:         $second.options[i].value = values[i];
1.36      matthew  1200:         $second.options[i].text = texts[i];
                   1201:         if (values[i] == select2def) {
                   1202:             $second.options[i].selected = true;
                   1203:         }
                   1204:     }
                   1205: }
1.824     bisitz   1206: // ]]>
1.36      matthew  1207: </script>
                   1208: END
                   1209:     # output the initial values for the selection lists
1.1245  ! raeburn  1210:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609     raeburn  1211:     my @order = sort(keys(%{$hashref}));
                   1212:     if (ref($menuorder) eq 'ARRAY') {
                   1213:         @order = @{$menuorder};
                   1214:     }
                   1215:     foreach my $value (@order) {
1.36      matthew  1216:         $result.="    <option value=\"$value\" ";
1.253     albertel 1217:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1218:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1219:     }
                   1220:     $result .= "</select>\n";
                   1221:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1222:     $result .= $middletext;
1.1115    raeburn  1223:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1224:     if ($onchangesecond) {
                   1225:         $result .= ' onchange="'.$onchangesecond.'"';
                   1226:     }
                   1227:     $result .= ">\n";
1.36      matthew  1228:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1229:     
                   1230:     my @secondorder = sort(keys(%select2));
                   1231:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1232:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1233:     }
                   1234:     foreach my $value (@secondorder) {
1.36      matthew  1235:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1236:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1237:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1238:     }
                   1239:     $result .= "</select>\n";
                   1240:     #    return $debug;
                   1241:     return $result;
                   1242: }   #  end of sub linked_select_forms {
                   1243: 
1.45      matthew  1244: =pod
1.44      bowersj2 1245: 
1.973     raeburn  1246: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1247: 
1.112     bowersj2 1248: Returns a string corresponding to an HTML link to the given help
                   1249: $topic, where $topic corresponds to the name of a .tex file in
                   1250: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1251: spaces. 
                   1252: 
                   1253: $text will optionally be linked to the same topic, allowing you to
                   1254: link text in addition to the graphic. If you do not want to link
                   1255: text, but wish to specify one of the later parameters, pass an
                   1256: empty string. 
                   1257: 
                   1258: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1259: the link will not open a new window. If false, the link will open
                   1260: a new window using Javascript. (Default is false.) 
                   1261: 
                   1262: $width and $height are optional numerical parameters that will
                   1263: override the width and height of the popped up window, which may
1.973     raeburn  1264: be useful for certain help topics with big pictures included.
                   1265: 
                   1266: $imgid is the id of the img tag used for the help icon. This may be
                   1267: used in a javascript call to switch the image src.  See 
                   1268: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1269: 
                   1270: =cut
                   1271: 
                   1272: sub help_open_topic {
1.973     raeburn  1273:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1274:     $text = "" if (not defined $text);
1.44      bowersj2 1275:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1276:     $width = 500 if (not defined $width);
1.44      bowersj2 1277:     $height = 400 if (not defined $height);
                   1278:     my $filename = $topic;
                   1279:     $filename =~ s/ /_/g;
                   1280: 
1.48      bowersj2 1281:     my $template = "";
                   1282:     my $link;
1.572     banghart 1283:     
1.159     www      1284:     $topic=~s/\W/\_/g;
1.44      bowersj2 1285: 
1.572     banghart 1286:     if (!$stayOnPage) {
1.1033    www      1287: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1288:     } elsif ($stayOnPage eq 'popup') {
                   1289:         $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.572     banghart 1290:     } else {
1.48      bowersj2 1291: 	$link = "/adm/help/${filename}.hlp";
                   1292:     }
                   1293: 
                   1294:     # Add the text
1.755     neumanie 1295:     if ($text ne "") {	
1.763     bisitz   1296: 	$template.='<span class="LC_help_open_topic">'
                   1297:                   .'<a target="_top" href="'.$link.'">'
                   1298:                   .$text.'</a>';
1.48      bowersj2 1299:     }
                   1300: 
1.763     bisitz   1301:     # (Always) Add the graphic
1.179     matthew  1302:     my $title = &mt('Online Help');
1.667     raeburn  1303:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1304:     if ($imgid ne '') {
                   1305:         $imgid = ' id="'.$imgid.'"';
                   1306:     }
1.763     bisitz   1307:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1308:               .'<img src="'.$helpicon.'" border="0"'
                   1309:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1310:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1311:               .' /></a>';
                   1312:     if ($text ne "") {	
                   1313:         $template.='</span>';
                   1314:     }
1.44      bowersj2 1315:     return $template;
                   1316: 
1.106     bowersj2 1317: }
                   1318: 
                   1319: # This is a quicky function for Latex cheatsheet editing, since it 
                   1320: # appears in at least four places
                   1321: sub helpLatexCheatsheet {
1.1037    www      1322:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1323:     my $out;
1.106     bowersj2 1324:     my $addOther = '';
1.732     raeburn  1325:     if ($topic) {
1.1037    www      1326: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1327:     }
                   1328:     $out = '<span>' # Start cheatsheet
                   1329: 	  .$addOther
                   1330:           .'<span>'
1.1037    www      1331: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1332: 	  .'</span> <span>'
1.1037    www      1333: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1334: 	  .'</span>';
1.732     raeburn  1335:     unless ($not_author) {
1.1186    kruse    1336:         $out .= '<span>'
                   1337:                .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                   1338:                .'</span> <span>'
                   1339:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763     bisitz   1340: 	       .'</span>';
1.732     raeburn  1341:     }
1.763     bisitz   1342:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1343:     return $out;
1.172     www      1344: }
                   1345: 
1.430     albertel 1346: sub general_help {
                   1347:     my $helptopic='Student_Intro';
                   1348:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1349: 	$helptopic='Authoring_Intro';
1.907     raeburn  1350:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1351: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1352:     } elsif ($env{'request.role'}=~/^dc/) {
                   1353:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1354:     }
                   1355:     return $helptopic;
                   1356: }
                   1357: 
                   1358: sub update_help_link {
                   1359:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1360:     my $origurl = $ENV{'REQUEST_URI'};
                   1361:     $origurl=~s|^/~|/priv/|;
                   1362:     my $timestamp = time;
                   1363:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1364:         $$datum = &escape($$datum);
                   1365:     }
                   1366: 
                   1367:     my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
                   1368:     my $output .= <<"ENDOUTPUT";
                   1369: <script type="text/javascript">
1.824     bisitz   1370: // <![CDATA[
1.430     albertel 1371: banner_link = '$banner_link';
1.824     bisitz   1372: // ]]>
1.430     albertel 1373: </script>
                   1374: ENDOUTPUT
                   1375:     return $output;
                   1376: }
                   1377: 
                   1378: # now just updates the help link and generates a blue icon
1.193     raeburn  1379: sub help_open_menu {
1.430     albertel 1380:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1381: 	= @_;    
1.949     droeschl 1382:     $stayOnPage = 1;
1.430     albertel 1383:     my $output;
                   1384:     if ($component_help) {
                   1385: 	if (!$text) {
                   1386: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1387: 				       $width,$height);
                   1388: 	} else {
                   1389: 	    my $help_text;
                   1390: 	    $help_text=&unescape($topic);
                   1391: 	    $output='<table><tr><td>'.
                   1392: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1393: 				 $width,$height).'</td></tr></table>';
                   1394: 	}
                   1395:     }
                   1396:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1397:     return $output.$banner_link;
                   1398: }
                   1399: 
                   1400: sub top_nav_help {
                   1401:     my ($text) = @_;
1.436     albertel 1402:     $text = &mt($text);
1.949     droeschl 1403:     my $stay_on_page = 1;
                   1404: 
1.1168    raeburn  1405:     my ($link,$banner_link);
                   1406:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1407:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1408: 	                         : "javascript:helpMenu('open')";
                   1409:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1410:     }
1.201     raeburn  1411:     my $title = &mt('Get help');
1.1168    raeburn  1412:     if ($link) {
                   1413:         return <<"END";
1.436     albertel 1414: $banner_link
1.1159    raeburn  1415: <a href="$link" title="$title">$text</a>
1.436     albertel 1416: END
1.1168    raeburn  1417:     } else {
                   1418:         return '&nbsp;'.$text.'&nbsp;';
                   1419:     }
1.436     albertel 1420: }
                   1421: 
                   1422: sub help_menu_js {
1.1154    raeburn  1423:     my ($httphost) = @_;
1.949     droeschl 1424:     my $stayOnPage = 1;
1.436     albertel 1425:     my $width = 620;
                   1426:     my $height = 600;
1.430     albertel 1427:     my $helptopic=&general_help();
1.1154    raeburn  1428:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1429:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1430:     my $start_page =
                   1431:         &Apache::loncommon::start_page('Help Menu', undef,
                   1432: 				       {'frameset'    => 1,
                   1433: 					'js_ready'    => 1,
1.1154    raeburn  1434:                                         'use_absolute' => $httphost,
1.331     albertel 1435: 					'add_entries' => {
1.1168    raeburn  1436: 					    'border' => '0', 
1.579     raeburn  1437: 					    'rows'   => "110,*",},});
1.331     albertel 1438:     my $end_page =
                   1439:         &Apache::loncommon::end_page({'frameset' => 1,
                   1440: 				      'js_ready' => 1,});
                   1441: 
1.436     albertel 1442:     my $template .= <<"ENDTEMPLATE";
                   1443: <script type="text/javascript">
1.877     bisitz   1444: // <![CDATA[
1.253     albertel 1445: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1446: var banner_link = '';
1.243     raeburn  1447: function helpMenu(target) {
                   1448:     var caller = this;
                   1449:     if (target == 'open') {
                   1450:         var newWindow = null;
                   1451:         try {
1.262     albertel 1452:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1453:         }
                   1454:         catch(error) {
                   1455:             writeHelp(caller);
                   1456:             return;
                   1457:         }
                   1458:         if (newWindow) {
                   1459:             caller = newWindow;
                   1460:         }
1.193     raeburn  1461:     }
1.243     raeburn  1462:     writeHelp(caller);
                   1463:     return;
                   1464: }
                   1465: function writeHelp(caller) {
1.1168    raeburn  1466:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1467:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1468:     caller.document.close();
                   1469:     caller.focus();
1.193     raeburn  1470: }
1.877     bisitz   1471: // END LON-CAPA Internal -->
1.253     albertel 1472: // ]]>
1.436     albertel 1473: </script>
1.193     raeburn  1474: ENDTEMPLATE
                   1475:     return $template;
                   1476: }
                   1477: 
1.172     www      1478: sub help_open_bug {
                   1479:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1480:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1481:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1482:     $text = "" if (not defined $text);
                   1483: 	$stayOnPage=1;
1.184     albertel 1484:     $width = 600 if (not defined $width);
                   1485:     $height = 600 if (not defined $height);
1.172     www      1486: 
                   1487:     $topic=~s/\W+/\+/g;
                   1488:     my $link='';
                   1489:     my $template='';
1.379     albertel 1490:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1491: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1492:     if (!$stayOnPage)
                   1493:     {
                   1494: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1495:     }
                   1496:     else
                   1497:     {
                   1498: 	$link = $url;
                   1499:     }
                   1500:     # Add the text
                   1501:     if ($text ne "")
                   1502:     {
                   1503: 	$template .= 
                   1504:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1505:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1506:     }
                   1507: 
                   1508:     # Add the graphic
1.179     matthew  1509:     my $title = &mt('Report a Bug');
1.215     albertel 1510:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1511:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1512:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1513: ENDTEMPLATE
                   1514:     if ($text ne '') { $template.='</td></tr></table>' };
                   1515:     return $template;
                   1516: 
                   1517: }
                   1518: 
                   1519: sub help_open_faq {
                   1520:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1521:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1522:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1523:     $text = "" if (not defined $text);
                   1524: 	$stayOnPage=1;
                   1525:     $width = 350 if (not defined $width);
                   1526:     $height = 400 if (not defined $height);
                   1527: 
                   1528:     $topic=~s/\W+/\+/g;
                   1529:     my $link='';
                   1530:     my $template='';
                   1531:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1532:     if (!$stayOnPage)
                   1533:     {
                   1534: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1535:     }
                   1536:     else
                   1537:     {
                   1538: 	$link = $url;
                   1539:     }
                   1540: 
                   1541:     # Add the text
                   1542:     if ($text ne "")
                   1543:     {
                   1544: 	$template .= 
1.173     www      1545:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1546:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1547:     }
                   1548: 
                   1549:     # Add the graphic
1.179     matthew  1550:     my $title = &mt('View the FAQ');
1.215     albertel 1551:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1552:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1553:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1554: ENDTEMPLATE
                   1555:     if ($text ne '') { $template.='</td></tr></table>' };
                   1556:     return $template;
                   1557: 
1.44      bowersj2 1558: }
1.37      matthew  1559: 
1.180     matthew  1560: ###############################################################
                   1561: ###############################################################
                   1562: 
1.45      matthew  1563: =pod
                   1564: 
1.648     raeburn  1565: =item * &change_content_javascript():
1.256     matthew  1566: 
                   1567: This and the next function allow you to create small sections of an
                   1568: otherwise static HTML page that you can update on the fly with
                   1569: Javascript, even in Netscape 4.
                   1570: 
                   1571: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1572: must be written to the HTML page once. It will prove the Javascript
                   1573: function "change(name, content)". Calling the change function with the
                   1574: name of the section 
                   1575: you want to update, matching the name passed to C<changable_area>, and
                   1576: the new content you want to put in there, will put the content into
                   1577: that area.
                   1578: 
                   1579: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1580: to contain room for the original contents. You need to "make space"
                   1581: for whatever changes you wish to make, and be B<sure> to check your
                   1582: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1583: it's adequate for updating a one-line status display, but little more.
                   1584: This script will set the space to 100% width, so you only need to
                   1585: worry about height in Netscape 4.
                   1586: 
                   1587: Modern browsers are much less limiting, and if you can commit to the
                   1588: user not using Netscape 4, this feature may be used freely with
                   1589: pretty much any HTML.
                   1590: 
                   1591: =cut
                   1592: 
                   1593: sub change_content_javascript {
                   1594:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1595:     if ($env{'browser.type'} eq 'netscape' &&
                   1596: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1597: 	return (<<NETSCAPE4);
                   1598: 	function change(name, content) {
                   1599: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1600: 	    doc.open();
                   1601: 	    doc.write(content);
                   1602: 	    doc.close();
                   1603: 	}
                   1604: NETSCAPE4
                   1605:     } else {
                   1606: 	# Otherwise, we need to use semi-standards-compliant code
                   1607: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1608: 	# is really scary, and every useful browser supports it
                   1609: 	return (<<DOMBASED);
                   1610: 	function change(name, content) {
                   1611: 	    element = document.getElementById(name);
                   1612: 	    element.innerHTML = content;
                   1613: 	}
                   1614: DOMBASED
                   1615:     }
                   1616: }
                   1617: 
                   1618: =pod
                   1619: 
1.648     raeburn  1620: =item * &changable_area($name,$origContent):
1.256     matthew  1621: 
                   1622: This provides a "changable area" that can be modified on the fly via
                   1623: the Javascript code provided in C<change_content_javascript>. $name is
                   1624: the name you will use to reference the area later; do not repeat the
                   1625: same name on a given HTML page more then once. $origContent is what
                   1626: the area will originally contain, which can be left blank.
                   1627: 
                   1628: =cut
                   1629: 
                   1630: sub changable_area {
                   1631:     my ($name, $origContent) = @_;
                   1632: 
1.258     albertel 1633:     if ($env{'browser.type'} eq 'netscape' &&
                   1634: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1635: 	# If this is netscape 4, we need to use the Layer tag
                   1636: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1637:     } else {
                   1638: 	return "<span id='$name'>$origContent</span>";
                   1639:     }
                   1640: }
                   1641: 
                   1642: =pod
                   1643: 
1.648     raeburn  1644: =item * &viewport_geometry_js 
1.590     raeburn  1645: 
                   1646: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1647: 
                   1648: =cut
                   1649: 
                   1650: 
                   1651: sub viewport_geometry_js { 
                   1652:     return <<"GEOMETRY";
                   1653: var Geometry = {};
                   1654: function init_geometry() {
                   1655:     if (Geometry.init) { return };
                   1656:     Geometry.init=1;
                   1657:     if (window.innerHeight) {
                   1658:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1659:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1660:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1661:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1662:     }
                   1663:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1664:         Geometry.getViewportHeight =
                   1665:             function() { return document.documentElement.clientHeight; };
                   1666:         Geometry.getViewportWidth =
                   1667:             function() { return document.documentElement.clientWidth; };
                   1668: 
                   1669:         Geometry.getHorizontalScroll =
                   1670:             function() { return document.documentElement.scrollLeft; };
                   1671:         Geometry.getVerticalScroll =
                   1672:             function() { return document.documentElement.scrollTop; };
                   1673:     }
                   1674:     else if (document.body.clientHeight) {
                   1675:         Geometry.getViewportHeight =
                   1676:             function() { return document.body.clientHeight; };
                   1677:         Geometry.getViewportWidth =
                   1678:             function() { return document.body.clientWidth; };
                   1679:         Geometry.getHorizontalScroll =
                   1680:             function() { return document.body.scrollLeft; };
                   1681:         Geometry.getVerticalScroll =
                   1682:             function() { return document.body.scrollTop; };
                   1683:     }
                   1684: }
                   1685: 
                   1686: GEOMETRY
                   1687: }
                   1688: 
                   1689: =pod
                   1690: 
1.648     raeburn  1691: =item * &viewport_size_js()
1.590     raeburn  1692: 
                   1693: Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. 
                   1694: 
                   1695: =cut
                   1696: 
                   1697: sub viewport_size_js {
                   1698:     my $geometry = &viewport_geometry_js();
                   1699:     return <<"DIMS";
                   1700: 
                   1701: $geometry
                   1702: 
                   1703: function getViewportDims(width,height) {
                   1704:     init_geometry();
                   1705:     width.value = Geometry.getViewportWidth();
                   1706:     height.value = Geometry.getViewportHeight();
                   1707:     return;
                   1708: }
                   1709: 
                   1710: DIMS
                   1711: }
                   1712: 
                   1713: =pod
                   1714: 
1.648     raeburn  1715: =item * &resize_textarea_js()
1.565     albertel 1716: 
                   1717: emits the needed javascript to resize a textarea to be as big as possible
                   1718: 
                   1719: creates a function resize_textrea that takes two IDs first should be
                   1720: the id of the element to resize, second should be the id of a div that
                   1721: surrounds everything that comes after the textarea, this routine needs
                   1722: to be attached to the <body> for the onload and onresize events.
                   1723: 
1.648     raeburn  1724: =back
1.565     albertel 1725: 
                   1726: =cut
                   1727: 
                   1728: sub resize_textarea_js {
1.590     raeburn  1729:     my $geometry = &viewport_geometry_js();
1.565     albertel 1730:     return <<"RESIZE";
                   1731:     <script type="text/javascript">
1.824     bisitz   1732: // <![CDATA[
1.590     raeburn  1733: $geometry
1.565     albertel 1734: 
1.588     albertel 1735: function getX(element) {
                   1736:     var x = 0;
                   1737:     while (element) {
                   1738: 	x += element.offsetLeft;
                   1739: 	element = element.offsetParent;
                   1740:     }
                   1741:     return x;
                   1742: }
                   1743: function getY(element) {
                   1744:     var y = 0;
                   1745:     while (element) {
                   1746: 	y += element.offsetTop;
                   1747: 	element = element.offsetParent;
                   1748:     }
                   1749:     return y;
                   1750: }
                   1751: 
                   1752: 
1.565     albertel 1753: function resize_textarea(textarea_id,bottom_id) {
                   1754:     init_geometry();
                   1755:     var textarea        = document.getElementById(textarea_id);
                   1756:     //alert(textarea);
                   1757: 
1.588     albertel 1758:     var textarea_top    = getY(textarea);
1.565     albertel 1759:     var textarea_height = textarea.offsetHeight;
                   1760:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1761:     var bottom_top      = getY(bottom);
1.565     albertel 1762:     var bottom_height   = bottom.offsetHeight;
                   1763:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1764:     var fudge           = 23;
1.565     albertel 1765:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1766:     if (new_height < 300) {
                   1767: 	new_height = 300;
                   1768:     }
                   1769:     textarea.style.height=new_height+'px';
                   1770: }
1.824     bisitz   1771: // ]]>
1.565     albertel 1772: </script>
                   1773: RESIZE
                   1774: 
                   1775: }
                   1776: 
1.1205    golterma 1777: sub colorfuleditor_js {
                   1778:     return <<"COLORFULEDIT"
                   1779: <script type="text/javascript">
                   1780: // <![CDATA[>
                   1781:     function fold_box(curDepth, lastresource){
                   1782: 
                   1783:     // we need a list because there can be several blocks you need to fold in one tag
                   1784:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1785:     // but there is only one folding button per tag
                   1786:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1787: 
                   1788:         if(block.item(0).style.display == 'none'){
                   1789: 
                   1790:             foldbutton.value = '@{[&mt("Hide")]}';
                   1791:             for (i = 0; i < block.length; i++){
                   1792:                 block.item(i).style.display = '';
                   1793:             }
                   1794:         }else{
                   1795: 
                   1796:             foldbutton.value = '@{[&mt("Show")]}';
                   1797:             for (i = 0; i < block.length; i++){
                   1798:                 // block.item(i).style.visibility = 'collapse';
                   1799:                 block.item(i).style.display = 'none';
                   1800:             }
                   1801:         };
                   1802:         saveState(lastresource);
                   1803:     }
                   1804: 
                   1805:     function saveState (lastresource) {
                   1806: 
                   1807:         var tag_list = getTagList();
                   1808:         if(tag_list != null){
                   1809:             var timestamp = new Date().getTime();
                   1810:             var key = lastresource;
                   1811: 
                   1812:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1813:             // starting with timestamp
                   1814:             var value = timestamp+';';
                   1815: 
                   1816:             // building the list of key-value pairs
                   1817:             for(var i = 0; i < tag_list.length; i++){
                   1818:                 value += tag_list[i]+',';
                   1819:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1820:             }
                   1821: 
                   1822:             // only iterate whole storage if nothing to override
                   1823:             if(localStorage.getItem(key) == null){        
                   1824: 
                   1825:                 // prevent storage from growing large
                   1826:                 if(localStorage.length > 50){
                   1827:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1828:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1829:                     var oldest_key;
                   1830:                     
                   1831:                     for(var i = 1; i < localStorage.length; i++){
                   1832:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1833:                             oldest_key = localStorage.key(i);
                   1834:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1835:                         }
                   1836:                     }
                   1837:                     localStorage.removeItem(oldest_key);
                   1838:                 }
                   1839:             }
                   1840:             localStorage.setItem(key,value);
                   1841:         }
                   1842:     }
                   1843: 
                   1844:     // restore folding status of blocks (on page load)
                   1845:     function restoreState (lastresource) {
                   1846:         if(localStorage.getItem(lastresource) != null){
                   1847:             var key = lastresource;
                   1848:             var value = localStorage.getItem(key);
                   1849:             var regex_delTimestamp = /^\d+;/;
                   1850: 
                   1851:             value.replace(regex_delTimestamp, '');
                   1852: 
                   1853:             var valueArr = value.split(';');
                   1854:             var pairs;
                   1855:             var elements;
                   1856:             for (var i = 0; i < valueArr.length; i++){
                   1857:                 pairs = valueArr[i].split(',');
                   1858:                 elements = document.getElementsByName(pairs[0]);
                   1859: 
                   1860:                 for (var j = 0; j < elements.length; j++){  
                   1861:                     elements[j].style.display = pairs[1];
                   1862:                     if (pairs[1] == "none"){
                   1863:                         var regex_id = /([_\\d]+)\$/;
                   1864:                         regex_id.exec(pairs[0]);
                   1865:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   1866:                     }
                   1867:                 }
                   1868:             }
                   1869:         }
                   1870:     }
                   1871: 
                   1872:     function getTagList () {
                   1873:         
                   1874:         var stringToSearch = document.lonhomework.innerHTML;
                   1875: 
                   1876:         var ret = new Array();
                   1877:         var regex_findBlock = /(foldblock_.*?)"/g;
                   1878:         var tag_list = stringToSearch.match(regex_findBlock);
                   1879: 
                   1880:         if(tag_list != null){
                   1881:             for(var i = 0; i < tag_list.length; i++){            
                   1882:                 ret.push(tag_list[i].replace(/"/, ''));
                   1883:             }
                   1884:         }
                   1885:         return ret;
                   1886:     }
                   1887: 
                   1888:     function saveScrollPosition (resource) {
                   1889:         var tag_list = getTagList();
                   1890: 
                   1891:         // we dont always want to jump to the first block
                   1892:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   1893:         if(\$(window).scrollTop() > 170){
                   1894:             if(tag_list != null){
                   1895:                 var result;
                   1896:                 for(var i = 0; i < tag_list.length; i++){
                   1897:                     if(isElementInViewport(tag_list[i])){
                   1898:                         result += tag_list[i]+';';
                   1899:                     }
                   1900:                 }
                   1901:                 sessionStorage.setItem('anchor_'+resource, result);
                   1902:             }
                   1903:         } else {
                   1904:             // we dont need to save zero, just delete the item to leave everything tidy
                   1905:             sessionStorage.removeItem('anchor_'+resource);
                   1906:         }
                   1907:     }
                   1908: 
                   1909:     function restoreScrollPosition(resource){
                   1910: 
                   1911:         var elem = sessionStorage.getItem('anchor_'+resource);
                   1912:         if(elem != null){
                   1913:             var tag_list = elem.split(';');
                   1914:             var elem_list;
                   1915: 
                   1916:             for(var i = 0; i < tag_list.length; i++){
                   1917:                 elem_list = document.getElementsByName(tag_list[i]);
                   1918:                 
                   1919:                 if(elem_list.length > 0){
                   1920:                     elem = elem_list[0];
                   1921:                     break;
                   1922:                 }
                   1923:             }
                   1924:             elem.scrollIntoView();
                   1925:         }
                   1926:     }
                   1927: 
                   1928:     function isElementInViewport(el) {
                   1929: 
                   1930:         // change to last element instead of first
                   1931:         var elem = document.getElementsByName(el);
                   1932:         var rect = elem[0].getBoundingClientRect();
                   1933: 
                   1934:         return (
                   1935:             rect.top >= 0 &&
                   1936:             rect.left >= 0 &&
                   1937:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   1938:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   1939:         );
                   1940:     }
                   1941:     
                   1942:     function autosize(depth){
                   1943:         var cmInst = window['cm'+depth];
                   1944:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   1945: 
                   1946:         // is fixed size, switching to dynamic
                   1947:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   1948:             cmInst.setSize("","auto");
                   1949:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   1950:             sessionStorage.setItem("autosized_"+depth, "yes");
                   1951: 
                   1952:         // is dynamic size, switching to fixed
                   1953:         } else {
                   1954:             cmInst.setSize("","300px");
                   1955:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   1956:             sessionStorage.removeItem("autosized_"+depth);
                   1957:         }
                   1958:     }
                   1959: 
                   1960: 
                   1961: 
                   1962: // ]]>
                   1963: </script>
                   1964: COLORFULEDIT
                   1965: }
                   1966: 
                   1967: sub xmleditor_js {
                   1968:     return <<XMLEDIT
                   1969: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   1970: <script type="text/javascript">
                   1971: // <![CDATA[>
                   1972: 
                   1973:     function saveScrollPosition (resource) {
                   1974: 
                   1975:         var scrollPos = \$(window).scrollTop();
                   1976:         sessionStorage.setItem(resource,scrollPos);
                   1977:     }
                   1978: 
                   1979:     function restoreScrollPosition(resource){
                   1980: 
                   1981:         var scrollPos = sessionStorage.getItem(resource);
                   1982:         \$(window).scrollTop(scrollPos);
                   1983:     }
                   1984: 
                   1985:     // unless internet explorer
                   1986:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   1987: 
                   1988:         \$(document).ready(function() {
                   1989:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   1990:         });
                   1991:     }
                   1992: 
                   1993:     // inserts text at cursor position into codemirror (xml editor only)
                   1994:     function insertText(text){
                   1995:         cm.focus();
                   1996:         var curPos = cm.getCursor();
                   1997:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   1998:     }
                   1999: // ]]>
                   2000: </script>
                   2001: XMLEDIT
                   2002: }
                   2003: 
                   2004: sub insert_folding_button {
                   2005:     my $curDepth = $Apache::lonxml::curdepth;
                   2006:     my $lastresource = $env{'request.ambiguous'};
                   2007: 
                   2008:     return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
                   2009:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2010: }
                   2011: 
1.565     albertel 2012: =pod
                   2013: 
1.256     matthew  2014: =head1 Excel and CSV file utility routines
                   2015: 
                   2016: =cut
                   2017: 
                   2018: ###############################################################
                   2019: ###############################################################
                   2020: 
                   2021: =pod
                   2022: 
1.1162    raeburn  2023: =over 4
                   2024: 
1.648     raeburn  2025: =item * &csv_translate($text) 
1.37      matthew  2026: 
1.185     www      2027: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2028: format.
                   2029: 
                   2030: =cut
                   2031: 
1.180     matthew  2032: ###############################################################
                   2033: ###############################################################
1.37      matthew  2034: sub csv_translate {
                   2035:     my $text = shift;
                   2036:     $text =~ s/\"/\"\"/g;
1.209     albertel 2037:     $text =~ s/\n/ /g;
1.37      matthew  2038:     return $text;
                   2039: }
1.180     matthew  2040: 
                   2041: ###############################################################
                   2042: ###############################################################
                   2043: 
                   2044: =pod
                   2045: 
1.648     raeburn  2046: =item * &define_excel_formats()
1.180     matthew  2047: 
                   2048: Define some commonly used Excel cell formats.
                   2049: 
                   2050: Currently supported formats:
                   2051: 
                   2052: =over 4
                   2053: 
                   2054: =item header
                   2055: 
                   2056: =item bold
                   2057: 
                   2058: =item h1
                   2059: 
                   2060: =item h2
                   2061: 
                   2062: =item h3
                   2063: 
1.256     matthew  2064: =item h4
                   2065: 
                   2066: =item i
                   2067: 
1.180     matthew  2068: =item date
                   2069: 
                   2070: =back
                   2071: 
                   2072: Inputs: $workbook
                   2073: 
                   2074: Returns: $format, a hash reference.
                   2075: 
1.1057    foxr     2076: 
1.180     matthew  2077: =cut
                   2078: 
                   2079: ###############################################################
                   2080: ###############################################################
                   2081: sub define_excel_formats {
                   2082:     my ($workbook) = @_;
                   2083:     my $format;
                   2084:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2085:                                                 bottom    => 1,
                   2086:                                                 align     => 'center');
                   2087:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2088:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2089:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2090:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2091:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2092:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2093:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2094:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2095:     return $format;
                   2096: }
                   2097: 
                   2098: ###############################################################
                   2099: ###############################################################
1.113     bowersj2 2100: 
                   2101: =pod
                   2102: 
1.648     raeburn  2103: =item * &create_workbook()
1.255     matthew  2104: 
                   2105: Create an Excel worksheet.  If it fails, output message on the
                   2106: request object and return undefs.
                   2107: 
                   2108: Inputs: Apache request object
                   2109: 
                   2110: Returns (undef) on failure, 
                   2111:     Excel worksheet object, scalar with filename, and formats 
                   2112:     from &Apache::loncommon::define_excel_formats on success
                   2113: 
                   2114: =cut
                   2115: 
                   2116: ###############################################################
                   2117: ###############################################################
                   2118: sub create_workbook {
                   2119:     my ($r) = @_;
                   2120:         #
                   2121:     # Create the excel spreadsheet
                   2122:     my $filename = '/prtspool/'.
1.258     albertel 2123:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2124:         time.'_'.rand(1000000000).'.xls';
                   2125:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2126:     if (! defined($workbook)) {
                   2127:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2128:         $r->print(
                   2129:             '<p class="LC_error">'
                   2130:            .&mt('Problems occurred in creating the new Excel file.')
                   2131:            .' '.&mt('This error has been logged.')
                   2132:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2133:            .'</p>'
                   2134:         );
1.255     matthew  2135:         return (undef);
                   2136:     }
                   2137:     #
1.1014    foxr     2138:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2139:     #
                   2140:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2141:     return ($workbook,$filename,$format);
                   2142: }
                   2143: 
                   2144: ###############################################################
                   2145: ###############################################################
                   2146: 
                   2147: =pod
                   2148: 
1.648     raeburn  2149: =item * &create_text_file()
1.113     bowersj2 2150: 
1.542     raeburn  2151: Create a file to write to and eventually make available to the user.
1.256     matthew  2152: If file creation fails, outputs an error message on the request object and 
                   2153: return undefs.
1.113     bowersj2 2154: 
1.256     matthew  2155: Inputs: Apache request object, and file suffix
1.113     bowersj2 2156: 
1.256     matthew  2157: Returns (undef) on failure, 
                   2158:     Filehandle and filename on success.
1.113     bowersj2 2159: 
                   2160: =cut
                   2161: 
1.256     matthew  2162: ###############################################################
                   2163: ###############################################################
                   2164: sub create_text_file {
                   2165:     my ($r,$suffix) = @_;
                   2166:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2167:     my $fh;
                   2168:     my $filename = '/prtspool/'.
1.258     albertel 2169:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2170:         time.'_'.rand(1000000000).'.'.$suffix;
                   2171:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2172:     if (! defined($fh)) {
                   2173:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2174:         $r->print(
                   2175:             '<p class="LC_error">'
                   2176:            .&mt('Problems occurred in creating the output file.')
                   2177:            .' '.&mt('This error has been logged.')
                   2178:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2179:            .'</p>'
                   2180:         );
1.113     bowersj2 2181:     }
1.256     matthew  2182:     return ($fh,$filename)
1.113     bowersj2 2183: }
                   2184: 
                   2185: 
1.256     matthew  2186: =pod 
1.113     bowersj2 2187: 
                   2188: =back
                   2189: 
                   2190: =cut
1.37      matthew  2191: 
                   2192: ###############################################################
1.33      matthew  2193: ##        Home server <option> list generating code          ##
                   2194: ###############################################################
1.35      matthew  2195: 
1.169     www      2196: # ------------------------------------------
                   2197: 
                   2198: sub domain_select {
                   2199:     my ($name,$value,$multiple)=@_;
                   2200:     my %domains=map { 
1.514     albertel 2201: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 2202:     } &Apache::lonnet::all_domains();
1.169     www      2203:     if ($multiple) {
                   2204: 	$domains{''}=&mt('Any domain');
1.550     albertel 2205: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2206: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2207:     } else {
1.550     albertel 2208: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2209: 	return &select_form($name,$value,\%domains);
1.169     www      2210:     }
                   2211: }
                   2212: 
1.282     albertel 2213: #-------------------------------------------
                   2214: 
                   2215: =pod
                   2216: 
1.519     raeburn  2217: =head1 Routines for form select boxes
                   2218: 
                   2219: =over 4
                   2220: 
1.648     raeburn  2221: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2222: 
                   2223: Returns a string containing a <select> element int multiple mode
                   2224: 
                   2225: 
                   2226: Args:
                   2227:   $name - name of the <select> element
1.506     raeburn  2228:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2229:   $size - number of rows long the select element is
1.283     albertel 2230:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2231:           (shown text should already have been &mt())
1.506     raeburn  2232:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2233: 
1.282     albertel 2234: =cut
                   2235: 
                   2236: #-------------------------------------------
1.169     www      2237: sub multiple_select_form {
1.284     albertel 2238:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2239:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2240:     my $output='';
1.191     matthew  2241:     if (! defined($size)) {
                   2242:         $size = 4;
1.283     albertel 2243:         if (scalar(keys(%$hash))<4) {
                   2244:             $size = scalar(keys(%$hash));
1.191     matthew  2245:         }
                   2246:     }
1.734     bisitz   2247:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2248:     my @order;
1.506     raeburn  2249:     if (ref($order) eq 'ARRAY')  {
                   2250:         @order = @{$order};
                   2251:     } else {
                   2252:         @order = sort(keys(%$hash));
1.501     banghart 2253:     }
                   2254:     if (exists($$hash{'select_form_order'})) {
                   2255:         @order = @{$$hash{'select_form_order'}};
                   2256:     }
                   2257:         
1.284     albertel 2258:     foreach my $key (@order) {
1.356     albertel 2259:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2260:         $output.='selected="selected" ' if ($selected{$key});
                   2261:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2262:     }
                   2263:     $output.="</select>\n";
                   2264:     return $output;
                   2265: }
                   2266: 
1.88      www      2267: #-------------------------------------------
                   2268: 
                   2269: =pod
                   2270: 
1.970     raeburn  2271: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2272: 
                   2273: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2274: allow a user to select options from a ref to a hash containing:
                   2275: option_name => displayed text. An optional $onchange can include
                   2276: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2277: 
1.88      www      2278: See lonrights.pm for an example invocation and use.
                   2279: 
                   2280: =cut
                   2281: 
                   2282: #-------------------------------------------
                   2283: sub select_form {
1.1228    raeburn  2284:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2285:     return unless (ref($hashref) eq 'HASH');
                   2286:     if ($onchange) {
                   2287:         $onchange = ' onchange="'.$onchange.'"';
                   2288:     }
1.1228    raeburn  2289:     my $disabled;
                   2290:     if ($readonly) {
                   2291:         $disabled = ' disabled="disabled"';
                   2292:     }
                   2293:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2294:     my @keys;
1.970     raeburn  2295:     if (exists($hashref->{'select_form_order'})) {
                   2296: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2297:     } else {
1.970     raeburn  2298: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2299:     }
1.356     albertel 2300:     foreach my $key (@keys) {
                   2301:         $selectform.=
                   2302: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2303:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2304:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2305:     }
                   2306:     $selectform.="</select>";
                   2307:     return $selectform;
                   2308: }
                   2309: 
1.475     www      2310: # For display filters
                   2311: 
                   2312: sub display_filter {
1.1074    raeburn  2313:     my ($context) = @_;
1.475     www      2314:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2315:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2316:     my $phraseinput = 'hidden';
                   2317:     my $includeinput = 'hidden';
                   2318:     my ($checked,$includetypestext);
                   2319:     if ($env{'form.displayfilter'} eq 'containing') {
                   2320:         $phraseinput = 'text'; 
                   2321:         if ($context eq 'parmslog') {
                   2322:             $includeinput = 'checkbox';
                   2323:             if ($env{'form.includetypes'}) {
                   2324:                 $checked = ' checked="checked"';
                   2325:             }
                   2326:             $includetypestext = &mt('Include parameter types');
                   2327:         }
                   2328:     } else {
                   2329:         $includetypestext = '&nbsp;';
                   2330:     }
                   2331:     my ($additional,$secondid,$thirdid);
                   2332:     if ($context eq 'parmslog') {
                   2333:         $additional = 
                   2334:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2335:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2336:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2337:             '</label>';
                   2338:         $secondid = 'includetypes';
                   2339:         $thirdid = 'includetypestext';
                   2340:     }
                   2341:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2342:                                                     '$secondid','$thirdid')";
                   2343:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2344: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2345: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2346: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2347:            &mt('Filter: [_1]',
1.477     www      2348: 	   &select_form($env{'form.displayfilter'},
                   2349: 			'displayfilter',
1.970     raeburn  2350: 			{'currentfolder' => 'Current folder/page',
1.477     www      2351: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2352: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2353: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2354:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2355:                          '" />'.$additional;
                   2356: }
                   2357: 
                   2358: sub display_filter_js {
                   2359:     my $includetext = &mt('Include parameter types');
                   2360:     return <<"ENDJS";
                   2361:   
                   2362: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2363:     var firstType = 'hidden';
                   2364:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2365:         firstType = 'text';
                   2366:     }
                   2367:     firstObject = document.getElementById(firstid);
                   2368:     if (typeof(firstObject) == 'object') {
                   2369:         if (firstObject.type != firstType) {
                   2370:             changeInputType(firstObject,firstType);
                   2371:         }
                   2372:     }
                   2373:     if (context == 'parmslog') {
                   2374:         var secondType = 'hidden';
                   2375:         if (firstType == 'text') {
                   2376:             secondType = 'checkbox';
                   2377:         }
                   2378:         secondObject = document.getElementById(secondid);  
                   2379:         if (typeof(secondObject) == 'object') {
                   2380:             if (secondObject.type != secondType) {
                   2381:                 changeInputType(secondObject,secondType);
                   2382:             }
                   2383:         }
                   2384:         var textItem = document.getElementById(thirdid);
                   2385:         var currtext = textItem.innerHTML;
                   2386:         var newtext;
                   2387:         if (firstType == 'text') {
                   2388:             newtext = '$includetext';
                   2389:         } else {
                   2390:             newtext = '&nbsp;';
                   2391:         }
                   2392:         if (currtext != newtext) {
                   2393:             textItem.innerHTML = newtext;
                   2394:         }
                   2395:     }
                   2396:     return;
                   2397: }
                   2398: 
                   2399: function changeInputType(oldObject,newType) {
                   2400:     var newObject = document.createElement('input');
                   2401:     newObject.type = newType;
                   2402:     if (oldObject.size) {
                   2403:         newObject.size = oldObject.size;
                   2404:     }
                   2405:     if (oldObject.value) {
                   2406:         newObject.value = oldObject.value;
                   2407:     }
                   2408:     if (oldObject.name) {
                   2409:         newObject.name = oldObject.name;
                   2410:     }
                   2411:     if (oldObject.id) {
                   2412:         newObject.id = oldObject.id;
                   2413:     }
                   2414:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2415:     return;
                   2416: }
                   2417: 
                   2418: ENDJS
1.475     www      2419: }
                   2420: 
1.167     www      2421: sub gradeleveldescription {
                   2422:     my $gradelevel=shift;
                   2423:     my %gradelevels=(0 => 'Not specified',
                   2424: 		     1 => 'Grade 1',
                   2425: 		     2 => 'Grade 2',
                   2426: 		     3 => 'Grade 3',
                   2427: 		     4 => 'Grade 4',
                   2428: 		     5 => 'Grade 5',
                   2429: 		     6 => 'Grade 6',
                   2430: 		     7 => 'Grade 7',
                   2431: 		     8 => 'Grade 8',
                   2432: 		     9 => 'Grade 9',
                   2433: 		     10 => 'Grade 10',
                   2434: 		     11 => 'Grade 11',
                   2435: 		     12 => 'Grade 12',
                   2436: 		     13 => 'Grade 13',
                   2437: 		     14 => '100 Level',
                   2438: 		     15 => '200 Level',
                   2439: 		     16 => '300 Level',
                   2440: 		     17 => '400 Level',
                   2441: 		     18 => 'Graduate Level');
                   2442:     return &mt($gradelevels{$gradelevel});
                   2443: }
                   2444: 
1.163     www      2445: sub select_level_form {
                   2446:     my ($deflevel,$name)=@_;
                   2447:     unless ($deflevel) { $deflevel=0; }
1.167     www      2448:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2449:     for (my $i=0; $i<=18; $i++) {
                   2450:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2451:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2452:                 ">".&gradeleveldescription($i)."</option>\n";
                   2453:     }
                   2454:     $selectform.="</select>";
                   2455:     return $selectform;
1.163     www      2456: }
1.167     www      2457: 
1.35      matthew  2458: #-------------------------------------------
                   2459: 
1.45      matthew  2460: =pod
                   2461: 
1.1121    raeburn  2462: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2463: 
                   2464: Returns a string containing a <select name='$name' size='1'> form to 
                   2465: allow a user to select the domain to preform an operation in.  
                   2466: See loncreateuser.pm for an example invocation and use.
                   2467: 
1.90      www      2468: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2469: selected");
                   2470: 
1.743     raeburn  2471: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2472: 
1.910     raeburn  2473: The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
                   2474: 
1.1121    raeburn  2475: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2476: 
                   2477: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2478: 
1.35      matthew  2479: =cut
                   2480: 
                   2481: #-------------------------------------------
1.34      matthew  2482: sub select_dom_form {
1.1121    raeburn  2483:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2484:     if ($onchange) {
1.874     raeburn  2485:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2486:     }
1.1121    raeburn  2487:     my (@domains,%exclude);
1.910     raeburn  2488:     if (ref($incdoms) eq 'ARRAY') {
                   2489:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2490:     } else {
                   2491:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2492:     }
1.90      www      2493:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2494:     if (ref($excdoms) eq 'ARRAY') {
                   2495:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2496:     }
1.743     raeburn  2497:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2498:     foreach my $dom (@domains) {
1.1121    raeburn  2499:         next if ($exclude{$dom});
1.356     albertel 2500:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2501:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2502:         if ($showdomdesc) {
                   2503:             if ($dom ne '') {
                   2504:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2505:                 if ($domdesc ne '') {
                   2506:                     $selectdomain .= ' ('.$domdesc.')';
                   2507:                 }
                   2508:             } 
                   2509:         }
                   2510:         $selectdomain .= "</option>\n";
1.34      matthew  2511:     }
                   2512:     $selectdomain.="</select>";
                   2513:     return $selectdomain;
                   2514: }
                   2515: 
1.35      matthew  2516: #-------------------------------------------
                   2517: 
1.45      matthew  2518: =pod
                   2519: 
1.648     raeburn  2520: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2521: 
1.586     raeburn  2522: input: 4 arguments (two required, two optional) - 
                   2523:     $domain - domain of new user
                   2524:     $name - name of form element
                   2525:     $default - Value of 'default' causes a default item to be first 
                   2526:                             option, and selected by default. 
                   2527:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2528:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2529: output: returns 2 items: 
1.586     raeburn  2530: (a) form element which contains either:
                   2531:    (i) <select name="$name">
                   2532:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2533:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2534:        </select>
                   2535:        form item if there are multiple library servers in $domain, or
                   2536:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2537:        if there is only one library server in $domain.
                   2538: 
                   2539: (b) number of library servers found.
                   2540: 
                   2541: See loncreateuser.pm for example of use.
1.35      matthew  2542: 
                   2543: =cut
                   2544: 
                   2545: #-------------------------------------------
1.586     raeburn  2546: sub home_server_form_item {
                   2547:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2548:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2549:     my $result;
                   2550:     my $numlib = keys(%servers);
                   2551:     if ($numlib > 1) {
                   2552:         $result .= '<select name="'.$name.'" />'."\n";
                   2553:         if ($default) {
1.804     bisitz   2554:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2555:                        '</option>'."\n";
                   2556:         }
                   2557:         foreach my $hostid (sort(keys(%servers))) {
                   2558:             $result.= '<option value="'.$hostid.'">'.
                   2559: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2560:         }
                   2561:         $result .= '</select>'."\n";
                   2562:     } elsif ($numlib == 1) {
                   2563:         my $hostid;
                   2564:         foreach my $item (keys(%servers)) {
                   2565:             $hostid = $item;
                   2566:         }
                   2567:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2568:                    $hostid.'" />';
                   2569:                    if (!$hide) {
                   2570:                        $result .= $hostid.' '.$servers{$hostid};
                   2571:                    }
                   2572:                    $result .= "\n";
                   2573:     } elsif ($default) {
                   2574:         $result .= '<input type="hidden" name="'.$name.
                   2575:                    '" value="default" />';
                   2576:                    if (!$hide) {
                   2577:                        $result .= &mt('default');
                   2578:                    }
                   2579:                    $result .= "\n";
1.33      matthew  2580:     }
1.586     raeburn  2581:     return ($result,$numlib);
1.33      matthew  2582: }
1.112     bowersj2 2583: 
                   2584: =pod
                   2585: 
1.534     albertel 2586: =back 
                   2587: 
1.112     bowersj2 2588: =cut
1.87      matthew  2589: 
                   2590: ###############################################################
1.112     bowersj2 2591: ##                  Decoding User Agent                      ##
1.87      matthew  2592: ###############################################################
                   2593: 
                   2594: =pod
                   2595: 
1.112     bowersj2 2596: =head1 Decoding the User Agent
                   2597: 
                   2598: =over 4
                   2599: 
                   2600: =item * &decode_user_agent()
1.87      matthew  2601: 
                   2602: Inputs: $r
                   2603: 
                   2604: Outputs:
                   2605: 
                   2606: =over 4
                   2607: 
1.112     bowersj2 2608: =item * $httpbrowser
1.87      matthew  2609: 
1.112     bowersj2 2610: =item * $clientbrowser
1.87      matthew  2611: 
1.112     bowersj2 2612: =item * $clientversion
1.87      matthew  2613: 
1.112     bowersj2 2614: =item * $clientmathml
1.87      matthew  2615: 
1.112     bowersj2 2616: =item * $clientunicode
1.87      matthew  2617: 
1.112     bowersj2 2618: =item * $clientos
1.87      matthew  2619: 
1.1137    raeburn  2620: =item * $clientmobile
                   2621: 
1.1141    raeburn  2622: =item * $clientinfo
                   2623: 
1.1194    raeburn  2624: =item * $clientosversion
                   2625: 
1.87      matthew  2626: =back
                   2627: 
1.157     matthew  2628: =back 
                   2629: 
1.87      matthew  2630: =cut
                   2631: 
                   2632: ###############################################################
                   2633: ###############################################################
                   2634: sub decode_user_agent {
1.247     albertel 2635:     my ($r)=@_;
1.87      matthew  2636:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2637:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2638:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2639:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2640:     my $clientbrowser='unknown';
                   2641:     my $clientversion='0';
                   2642:     my $clientmathml='';
                   2643:     my $clientunicode='0';
1.1137    raeburn  2644:     my $clientmobile=0;
1.1194    raeburn  2645:     my $clientosversion='';
1.87      matthew  2646:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1193    raeburn  2647:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2648: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2649: 	    $clientbrowser=$bname;
                   2650:             $httpbrowser=~/$vreg/i;
                   2651: 	    $clientversion=$1;
                   2652:             $clientmathml=($clientversion>=$minv);
                   2653:             $clientunicode=($clientversion>=$univ);
                   2654: 	}
                   2655:     }
                   2656:     my $clientos='unknown';
1.1141    raeburn  2657:     my $clientinfo;
1.87      matthew  2658:     if (($httpbrowser=~/linux/i) ||
                   2659:         ($httpbrowser=~/unix/i) ||
                   2660:         ($httpbrowser=~/ux/i) ||
                   2661:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2662:     if (($httpbrowser=~/vax/i) ||
                   2663:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2664:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2665:     if (($httpbrowser=~/mac/i) ||
                   2666:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194    raeburn  2667:     if ($httpbrowser=~/win/i) {
                   2668:         $clientos='win';
                   2669:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2670:             $clientosversion = $1;
                   2671:         }
                   2672:     }
1.87      matthew  2673:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2674:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2675:         $clientmobile=lc($1);
                   2676:     }
1.1141    raeburn  2677:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2678:         $clientinfo = 'firefox-'.$1;
                   2679:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2680:         $clientinfo = 'chromeframe-'.$1;
                   2681:     }
1.87      matthew  2682:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194    raeburn  2683:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2684:             $clientosversion);
1.87      matthew  2685: }
                   2686: 
1.32      matthew  2687: ###############################################################
                   2688: ##    Authentication changing form generation subroutines    ##
                   2689: ###############################################################
                   2690: ##
                   2691: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2692: ## hash, and have reasonable default values.
                   2693: ##
                   2694: ##    formname = the name given in the <form> tag.
1.35      matthew  2695: #-------------------------------------------
                   2696: 
1.45      matthew  2697: =pod
                   2698: 
1.112     bowersj2 2699: =head1 Authentication Routines
                   2700: 
                   2701: =over 4
                   2702: 
1.648     raeburn  2703: =item * &authform_xxxxxx()
1.35      matthew  2704: 
                   2705: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2706: handle some of the conveniences required for authentication forms.  
                   2707: This is not an optimal method, but it works.  
                   2708: 
                   2709: =over 4
                   2710: 
1.112     bowersj2 2711: =item * authform_header
1.35      matthew  2712: 
1.112     bowersj2 2713: =item * authform_authorwarning
1.35      matthew  2714: 
1.112     bowersj2 2715: =item * authform_nochange
1.35      matthew  2716: 
1.112     bowersj2 2717: =item * authform_kerberos
1.35      matthew  2718: 
1.112     bowersj2 2719: =item * authform_internal
1.35      matthew  2720: 
1.112     bowersj2 2721: =item * authform_filesystem
1.35      matthew  2722: 
                   2723: =back
                   2724: 
1.648     raeburn  2725: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2726: 
1.35      matthew  2727: =cut
                   2728: 
                   2729: #-------------------------------------------
1.32      matthew  2730: sub authform_header{  
                   2731:     my %in = (
                   2732:         formname => 'cu',
1.80      albertel 2733:         kerb_def_dom => '',
1.32      matthew  2734:         @_,
                   2735:     );
                   2736:     $in{'formname'} = 'document.' . $in{'formname'};
                   2737:     my $result='';
1.80      albertel 2738: 
                   2739: #---------------------------------------------- Code for upper case translation
                   2740:     my $Javascript_toUpperCase;
                   2741:     unless ($in{kerb_def_dom}) {
                   2742:         $Javascript_toUpperCase =<<"END";
                   2743:         switch (choice) {
                   2744:            case 'krb': currentform.elements[choicearg].value =
                   2745:                currentform.elements[choicearg].value.toUpperCase();
                   2746:                break;
                   2747:            default:
                   2748:         }
                   2749: END
                   2750:     } else {
                   2751:         $Javascript_toUpperCase = "";
                   2752:     }
                   2753: 
1.165     raeburn  2754:     my $radioval = "'nochange'";
1.591     raeburn  2755:     if (defined($in{'curr_authtype'})) {
                   2756:         if ($in{'curr_authtype'} ne '') {
                   2757:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2758:         }
1.174     matthew  2759:     }
1.165     raeburn  2760:     my $argfield = 'null';
1.591     raeburn  2761:     if (defined($in{'mode'})) {
1.165     raeburn  2762:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2763:             if (defined($in{'curr_autharg'})) {
                   2764:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2765:                     $argfield = "'$in{'curr_autharg'}'";
                   2766:                 }
                   2767:             }
                   2768:         }
                   2769:     }
                   2770: 
1.32      matthew  2771:     $result.=<<"END";
                   2772: var current = new Object();
1.165     raeburn  2773: current.radiovalue = $radioval;
                   2774: current.argfield = $argfield;
1.32      matthew  2775: 
                   2776: function changed_radio(choice,currentform) {
                   2777:     var choicearg = choice + 'arg';
                   2778:     // If a radio button in changed, we need to change the argfield
                   2779:     if (current.radiovalue != choice) {
                   2780:         current.radiovalue = choice;
                   2781:         if (current.argfield != null) {
                   2782:             currentform.elements[current.argfield].value = '';
                   2783:         }
                   2784:         if (choice == 'nochange') {
                   2785:             current.argfield = null;
                   2786:         } else {
                   2787:             current.argfield = choicearg;
                   2788:             switch(choice) {
                   2789:                 case 'krb': 
                   2790:                     currentform.elements[current.argfield].value = 
                   2791:                         "$in{'kerb_def_dom'}";
                   2792:                 break;
                   2793:               default:
                   2794:                 break;
                   2795:             }
                   2796:         }
                   2797:     }
                   2798:     return;
                   2799: }
1.22      www      2800: 
1.32      matthew  2801: function changed_text(choice,currentform) {
                   2802:     var choicearg = choice + 'arg';
                   2803:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2804:         $Javascript_toUpperCase
1.32      matthew  2805:         // clear old field
                   2806:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2807:             currentform.elements[current.argfield].value = '';
                   2808:         }
                   2809:         current.argfield = choicearg;
                   2810:     }
                   2811:     set_auth_radio_buttons(choice,currentform);
                   2812:     return;
1.20      www      2813: }
1.32      matthew  2814: 
                   2815: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2816:     var numauthchoices = currentform.login.length;
                   2817:     if (typeof numauthchoices  == "undefined") {
                   2818:         return;
                   2819:     } 
1.32      matthew  2820:     var i=0;
1.986     raeburn  2821:     while (i < numauthchoices) {
1.32      matthew  2822:         if (currentform.login[i].value == newvalue) { break; }
                   2823:         i++;
                   2824:     }
1.986     raeburn  2825:     if (i == numauthchoices) {
1.32      matthew  2826:         return;
                   2827:     }
                   2828:     current.radiovalue = newvalue;
                   2829:     currentform.login[i].checked = true;
                   2830:     return;
                   2831: }
                   2832: END
                   2833:     return $result;
                   2834: }
                   2835: 
1.1106    raeburn  2836: sub authform_authorwarning {
1.32      matthew  2837:     my $result='';
1.144     matthew  2838:     $result='<i>'.
                   2839:         &mt('As a general rule, only authors or co-authors should be '.
                   2840:             'filesystem authenticated '.
                   2841:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2842:     return $result;
                   2843: }
                   2844: 
1.1106    raeburn  2845: sub authform_nochange {
1.32      matthew  2846:     my %in = (
                   2847:               formname => 'document.cu',
                   2848:               kerb_def_dom => 'MSU.EDU',
                   2849:               @_,
                   2850:           );
1.1106    raeburn  2851:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2852:     my $result;
1.1104    raeburn  2853:     if (!$authnum) {
1.1105    raeburn  2854:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2855:     } else {
                   2856:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2857:                   '<input type="radio" name="login" value="nochange" '.
                   2858:                   'checked="checked" onclick="'.
1.281     albertel 2859:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2860: 	    '</label>';
1.586     raeburn  2861:     }
1.32      matthew  2862:     return $result;
                   2863: }
                   2864: 
1.591     raeburn  2865: sub authform_kerberos {
1.32      matthew  2866:     my %in = (
                   2867:               formname => 'document.cu',
                   2868:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2869:               kerb_def_auth => 'krb4',
1.32      matthew  2870:               @_,
                   2871:               );
1.586     raeburn  2872:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2873:         $autharg,$jscall);
1.1106    raeburn  2874:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2875:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2876:        $check5 = ' checked="checked"';
1.80      albertel 2877:     } else {
1.772     bisitz   2878:        $check4 = ' checked="checked"';
1.80      albertel 2879:     }
1.165     raeburn  2880:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2881:     if (defined($in{'curr_authtype'})) {
                   2882:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2883:             $krbcheck = ' checked="checked"';
1.623     raeburn  2884:             if (defined($in{'mode'})) {
                   2885:                 if ($in{'mode'} eq 'modifyuser') {
                   2886:                     $krbcheck = '';
                   2887:                 }
                   2888:             }
1.591     raeburn  2889:             if (defined($in{'curr_kerb_ver'})) {
                   2890:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2891:                     $check5 = ' checked="checked"';
1.591     raeburn  2892:                     $check4 = '';
                   2893:                 } else {
1.772     bisitz   2894:                     $check4 = ' checked="checked"';
1.591     raeburn  2895:                     $check5 = '';
                   2896:                 }
1.586     raeburn  2897:             }
1.591     raeburn  2898:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2899:                 $krbarg = $in{'curr_autharg'};
                   2900:             }
1.586     raeburn  2901:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2902:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2903:                     $result = 
                   2904:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2905:         $in{'curr_autharg'},$krbver);
                   2906:                 } else {
                   2907:                     $result =
                   2908:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2909:                 }
                   2910:                 return $result; 
                   2911:             }
                   2912:         }
                   2913:     } else {
                   2914:         if ($authnum == 1) {
1.784     bisitz   2915:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2916:         }
                   2917:     }
1.586     raeburn  2918:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2919:         return;
1.587     raeburn  2920:     } elsif ($authtype eq '') {
1.591     raeburn  2921:         if (defined($in{'mode'})) {
1.587     raeburn  2922:             if ($in{'mode'} eq 'modifycourse') {
                   2923:                 if ($authnum == 1) {
1.1104    raeburn  2924:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2925:                 }
                   2926:             }
                   2927:         }
1.586     raeburn  2928:     }
                   2929:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2930:     if ($authtype eq '') {
                   2931:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2932:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2933:                     $krbcheck.' />';
                   2934:     }
                   2935:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2936:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2937:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2938:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2939:          $in{'curr_authtype'} eq 'krb4')) {
                   2940:         $result .= &mt
1.144     matthew  2941:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2942:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2943:          '<label>'.$authtype,
1.281     albertel 2944:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2945:              'value="'.$krbarg.'" '.
1.144     matthew  2946:              'onchange="'.$jscall.'" />',
1.281     albertel 2947:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2948:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2949: 	 '</label>');
1.586     raeburn  2950:     } elsif ($can_assign{'krb4'}) {
                   2951:         $result .= &mt
                   2952:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2953:          '[_3] Version 4 [_4]',
                   2954:          '<label>'.$authtype,
                   2955:          '</label><input type="text" size="10" name="krbarg" '.
                   2956:              'value="'.$krbarg.'" '.
                   2957:              'onchange="'.$jscall.'" />',
                   2958:          '<label><input type="hidden" name="krbver" value="4" />',
                   2959:          '</label>');
                   2960:     } elsif ($can_assign{'krb5'}) {
                   2961:         $result .= &mt
                   2962:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2963:          '[_3] Version 5 [_4]',
                   2964:          '<label>'.$authtype,
                   2965:          '</label><input type="text" size="10" name="krbarg" '.
                   2966:              'value="'.$krbarg.'" '.
                   2967:              'onchange="'.$jscall.'" />',
                   2968:          '<label><input type="hidden" name="krbver" value="5" />',
                   2969:          '</label>');
                   2970:     }
1.32      matthew  2971:     return $result;
                   2972: }
                   2973: 
1.1106    raeburn  2974: sub authform_internal {
1.586     raeburn  2975:     my %in = (
1.32      matthew  2976:                 formname => 'document.cu',
                   2977:                 kerb_def_dom => 'MSU.EDU',
                   2978:                 @_,
                   2979:                 );
1.586     raeburn  2980:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2981:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2982:     if (defined($in{'curr_authtype'})) {
                   2983:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2984:             if ($can_assign{'int'}) {
1.772     bisitz   2985:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2986:                 if (defined($in{'mode'})) {
                   2987:                     if ($in{'mode'} eq 'modifyuser') {
                   2988:                         $intcheck = '';
                   2989:                     }
                   2990:                 }
1.591     raeburn  2991:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2992:                     $intarg = $in{'curr_autharg'};
                   2993:                 }
                   2994:             } else {
                   2995:                 $result = &mt('Currently internally authenticated.');
                   2996:                 return $result;
1.165     raeburn  2997:             }
                   2998:         }
1.586     raeburn  2999:     } else {
                   3000:         if ($authnum == 1) {
1.784     bisitz   3001:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  3002:         }
                   3003:     }
                   3004:     if (!$can_assign{'int'}) {
                   3005:         return;
1.587     raeburn  3006:     } elsif ($authtype eq '') {
1.591     raeburn  3007:         if (defined($in{'mode'})) {
1.587     raeburn  3008:             if ($in{'mode'} eq 'modifycourse') {
                   3009:                 if ($authnum == 1) {
1.1104    raeburn  3010:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  3011:                 }
                   3012:             }
                   3013:         }
1.165     raeburn  3014:     }
1.586     raeburn  3015:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3016:     if ($authtype eq '') {
                   3017:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   3018:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   3019:     }
1.605     bisitz   3020:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  3021:                $intarg.'" onchange="'.$jscall.'" />';
                   3022:     $result = &mt
1.144     matthew  3023:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3024:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   3025:     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  3026:     return $result;
                   3027: }
                   3028: 
1.1104    raeburn  3029: sub authform_local {
1.32      matthew  3030:     my %in = (
                   3031:               formname => 'document.cu',
                   3032:               kerb_def_dom => 'MSU.EDU',
                   3033:               @_,
                   3034:               );
1.586     raeburn  3035:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3036:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3037:     if (defined($in{'curr_authtype'})) {
                   3038:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3039:             if ($can_assign{'loc'}) {
1.772     bisitz   3040:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3041:                 if (defined($in{'mode'})) {
                   3042:                     if ($in{'mode'} eq 'modifyuser') {
                   3043:                         $loccheck = '';
                   3044:                     }
                   3045:                 }
1.591     raeburn  3046:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3047:                     $locarg = $in{'curr_autharg'};
                   3048:                 }
                   3049:             } else {
                   3050:                 $result = &mt('Currently using local (institutional) authentication.');
                   3051:                 return $result;
1.165     raeburn  3052:             }
                   3053:         }
1.586     raeburn  3054:     } else {
                   3055:         if ($authnum == 1) {
1.784     bisitz   3056:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3057:         }
                   3058:     }
                   3059:     if (!$can_assign{'loc'}) {
                   3060:         return;
1.587     raeburn  3061:     } elsif ($authtype eq '') {
1.591     raeburn  3062:         if (defined($in{'mode'})) {
1.587     raeburn  3063:             if ($in{'mode'} eq 'modifycourse') {
                   3064:                 if ($authnum == 1) {
1.1104    raeburn  3065:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  3066:                 }
                   3067:             }
                   3068:         }
1.165     raeburn  3069:     }
1.586     raeburn  3070:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3071:     if ($authtype eq '') {
                   3072:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3073:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   3074:                     $jscall.'" />';
                   3075:     }
                   3076:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   3077:                $locarg.'" onchange="'.$jscall.'" />';
                   3078:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3079:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3080:     return $result;
                   3081: }
                   3082: 
1.1106    raeburn  3083: sub authform_filesystem {
1.32      matthew  3084:     my %in = (
                   3085:               formname => 'document.cu',
                   3086:               kerb_def_dom => 'MSU.EDU',
                   3087:               @_,
                   3088:               );
1.586     raeburn  3089:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3090:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3091:     if (defined($in{'curr_authtype'})) {
                   3092:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3093:             if ($can_assign{'fsys'}) {
1.772     bisitz   3094:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3095:                 if (defined($in{'mode'})) {
                   3096:                     if ($in{'mode'} eq 'modifyuser') {
                   3097:                         $fsyscheck = '';
                   3098:                     }
                   3099:                 }
1.586     raeburn  3100:             } else {
                   3101:                 $result = &mt('Currently Filesystem Authenticated.');
                   3102:                 return $result;
                   3103:             }           
                   3104:         }
                   3105:     } else {
                   3106:         if ($authnum == 1) {
1.784     bisitz   3107:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3108:         }
                   3109:     }
                   3110:     if (!$can_assign{'fsys'}) {
                   3111:         return;
1.587     raeburn  3112:     } elsif ($authtype eq '') {
1.591     raeburn  3113:         if (defined($in{'mode'})) {
1.587     raeburn  3114:             if ($in{'mode'} eq 'modifycourse') {
                   3115:                 if ($authnum == 1) {
1.1104    raeburn  3116:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  3117:                 }
                   3118:             }
                   3119:         }
1.586     raeburn  3120:     }
                   3121:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3122:     if ($authtype eq '') {
                   3123:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3124:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   3125:                     $jscall.'" />';
                   3126:     }
                   3127:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   3128:                ' onchange="'.$jscall.'" />';
                   3129:     $result = &mt
1.144     matthew  3130:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 3131:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  3132:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   3133:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  3134:                   'onchange="'.$jscall.'" />');
1.32      matthew  3135:     return $result;
                   3136: }
                   3137: 
1.586     raeburn  3138: sub get_assignable_auth {
                   3139:     my ($dom) = @_;
                   3140:     if ($dom eq '') {
                   3141:         $dom = $env{'request.role.domain'};
                   3142:     }
                   3143:     my %can_assign = (
                   3144:                           krb4 => 1,
                   3145:                           krb5 => 1,
                   3146:                           int  => 1,
                   3147:                           loc  => 1,
                   3148:                      );
                   3149:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3150:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3151:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3152:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3153:             my $context;
                   3154:             if ($env{'request.role'} =~ /^au/) {
                   3155:                 $context = 'author';
                   3156:             } elsif ($env{'request.role'} =~ /^dc/) {
                   3157:                 $context = 'domain';
                   3158:             } elsif ($env{'request.course.id'}) {
                   3159:                 $context = 'course';
                   3160:             }
                   3161:             if ($context) {
                   3162:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3163:                    %can_assign = %{$authhash->{$context}}; 
                   3164:                 }
                   3165:             }
                   3166:         }
                   3167:     }
                   3168:     my $authnum = 0;
                   3169:     foreach my $key (keys(%can_assign)) {
                   3170:         if ($can_assign{$key}) {
                   3171:             $authnum ++;
                   3172:         }
                   3173:     }
                   3174:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3175:         $authnum --;
                   3176:     }
                   3177:     return ($authnum,%can_assign);
                   3178: }
                   3179: 
1.80      albertel 3180: ###############################################################
                   3181: ##    Get Kerberos Defaults for Domain                 ##
                   3182: ###############################################################
                   3183: ##
                   3184: ## Returns default kerberos version and an associated argument
                   3185: ## as listed in file domain.tab. If not listed, provides
                   3186: ## appropriate default domain and kerberos version.
                   3187: ##
                   3188: #-------------------------------------------
                   3189: 
                   3190: =pod
                   3191: 
1.648     raeburn  3192: =item * &get_kerberos_defaults()
1.80      albertel 3193: 
                   3194: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3195: version and domain. If not found, it defaults to version 4 and the 
                   3196: domain of the server.
1.80      albertel 3197: 
1.648     raeburn  3198: =over 4
                   3199: 
1.80      albertel 3200: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3201: 
1.648     raeburn  3202: =back
                   3203: 
                   3204: =back
                   3205: 
1.80      albertel 3206: =cut
                   3207: 
                   3208: #-------------------------------------------
                   3209: sub get_kerberos_defaults {
                   3210:     my $domain=shift;
1.641     raeburn  3211:     my ($krbdef,$krbdefdom);
                   3212:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3213:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3214:         $krbdef = $domdefaults{'auth_def'};
                   3215:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3216:     } else {
1.80      albertel 3217:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3218:         my $krbdefdom=$1;
                   3219:         $krbdefdom=~tr/a-z/A-Z/;
                   3220:         $krbdef = "krb4";
                   3221:     }
                   3222:     return ($krbdef,$krbdefdom);
                   3223: }
1.112     bowersj2 3224: 
1.32      matthew  3225: 
1.46      matthew  3226: ###############################################################
                   3227: ##                Thesaurus Functions                        ##
                   3228: ###############################################################
1.20      www      3229: 
1.46      matthew  3230: =pod
1.20      www      3231: 
1.112     bowersj2 3232: =head1 Thesaurus Functions
                   3233: 
                   3234: =over 4
                   3235: 
1.648     raeburn  3236: =item * &initialize_keywords()
1.46      matthew  3237: 
                   3238: Initializes the package variable %Keywords if it is empty.  Uses the
                   3239: package variable $thesaurus_db_file.
                   3240: 
                   3241: =cut
                   3242: 
                   3243: ###################################################
                   3244: 
                   3245: sub initialize_keywords {
                   3246:     return 1 if (scalar keys(%Keywords));
                   3247:     # If we are here, %Keywords is empty, so fill it up
                   3248:     #   Make sure the file we need exists...
                   3249:     if (! -e $thesaurus_db_file) {
                   3250:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3251:                                  " failed because it does not exist");
                   3252:         return 0;
                   3253:     }
                   3254:     #   Set up the hash as a database
                   3255:     my %thesaurus_db;
                   3256:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3257:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3258:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3259:                                  $thesaurus_db_file);
                   3260:         return 0;
                   3261:     } 
                   3262:     #  Get the average number of appearances of a word.
                   3263:     my $avecount = $thesaurus_db{'average.count'};
                   3264:     #  Put keywords (those that appear > average) into %Keywords
                   3265:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3266:         my ($count,undef) = split /:/,$data;
                   3267:         $Keywords{$word}++ if ($count > $avecount);
                   3268:     }
                   3269:     untie %thesaurus_db;
                   3270:     # Remove special values from %Keywords.
1.356     albertel 3271:     foreach my $value ('total.count','average.count') {
                   3272:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3273:   }
1.46      matthew  3274:     return 1;
                   3275: }
                   3276: 
                   3277: ###################################################
                   3278: 
                   3279: =pod
                   3280: 
1.648     raeburn  3281: =item * &keyword($word)
1.46      matthew  3282: 
                   3283: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3284: than the average number of times in the thesaurus database.  Calls 
                   3285: &initialize_keywords
                   3286: 
                   3287: =cut
                   3288: 
                   3289: ###################################################
1.20      www      3290: 
                   3291: sub keyword {
1.46      matthew  3292:     return if (!&initialize_keywords());
                   3293:     my $word=lc(shift());
                   3294:     $word=~s/\W//g;
                   3295:     return exists($Keywords{$word});
1.20      www      3296: }
1.46      matthew  3297: 
                   3298: ###############################################################
                   3299: 
                   3300: =pod 
1.20      www      3301: 
1.648     raeburn  3302: =item * &get_related_words()
1.46      matthew  3303: 
1.160     matthew  3304: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3305: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3306: will be returned.  The order of the words returned is determined by the
                   3307: database which holds them.
                   3308: 
                   3309: Uses global $thesaurus_db_file.
                   3310: 
1.1057    foxr     3311: 
1.46      matthew  3312: =cut
                   3313: 
                   3314: ###############################################################
                   3315: sub get_related_words {
                   3316:     my $keyword = shift;
                   3317:     my %thesaurus_db;
                   3318:     if (! -e $thesaurus_db_file) {
                   3319:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3320:                                  "failed because the file does not exist");
                   3321:         return ();
                   3322:     }
                   3323:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3324:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3325:         return ();
                   3326:     } 
                   3327:     my @Words=();
1.429     www      3328:     my $count=0;
1.46      matthew  3329:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3330: 	# The first element is the number of times
                   3331: 	# the word appears.  We do not need it now.
1.429     www      3332: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3333: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3334: 	my $threshold=$mostfrequentcount/10;
                   3335:         foreach my $possibleword (@RelatedWords) {
                   3336:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3337:             if ($wordcount>$threshold) {
                   3338: 		push(@Words,$word);
                   3339:                 $count++;
                   3340:                 if ($count>10) { last; }
                   3341: 	    }
1.20      www      3342:         }
                   3343:     }
1.46      matthew  3344:     untie %thesaurus_db;
                   3345:     return @Words;
1.14      harris41 3346: }
1.1090    foxr     3347: ###############################################################
                   3348: #
                   3349: #  Spell checking
                   3350: #
                   3351: 
                   3352: =pod
                   3353: 
1.1142    raeburn  3354: =back
                   3355: 
1.1090    foxr     3356: =head1 Spell checking
                   3357: 
                   3358: =over 4
                   3359: 
                   3360: =item * &check_spelling($wordlist $language)
                   3361: 
                   3362: Takes a string containing words and feeds it to an external
                   3363: spellcheck program via a pipeline. Returns a string containing
                   3364: them mis-spelled words.
                   3365: 
                   3366: Parameters:
                   3367: 
                   3368: =over 4
                   3369: 
                   3370: =item - $wordlist
                   3371: 
                   3372: String that will be fed into the spellcheck program.
                   3373: 
                   3374: =item - $language
                   3375: 
                   3376: Language string that specifies the language for which the spell
                   3377: check will be performed.
                   3378: 
                   3379: =back
                   3380: 
                   3381: =back
                   3382: 
                   3383: Note: This sub assumes that aspell is installed.
                   3384: 
                   3385: 
                   3386: =cut
                   3387: 
1.46      matthew  3388: 
1.1090    foxr     3389: sub check_spelling {
                   3390:     my ($wordlist, $language) = @_;
1.1091    foxr     3391:     my @misspellings;
                   3392:     
                   3393:     # Generate the speller and set the langauge.
                   3394:     # if explicitly selected:
1.1090    foxr     3395: 
1.1091    foxr     3396:     my $speller = Text::Aspell->new;
1.1090    foxr     3397:     if ($language) {
1.1091    foxr     3398: 	$speller->set_option('lang', $language);
1.1090    foxr     3399:     }
                   3400: 
1.1091    foxr     3401:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3402: 
1.1091    foxr     3403:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3404: 
1.1091    foxr     3405:     foreach my $word (@words) {
                   3406: 	if(! $speller->check($word)) {
                   3407: 	    push(@misspellings, $word);
1.1090    foxr     3408: 	}
                   3409:     }
1.1091    foxr     3410:     return join(' ', @misspellings);
                   3411:     
1.1090    foxr     3412: }
                   3413: 
1.61      www      3414: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3415: =pod
                   3416: 
1.112     bowersj2 3417: =head1 User Name Functions
                   3418: 
                   3419: =over 4
                   3420: 
1.648     raeburn  3421: =item * &plainname($uname,$udom,$first)
1.81      albertel 3422: 
1.112     bowersj2 3423: Takes a users logon name and returns it as a string in
1.226     albertel 3424: "first middle last generation" form 
                   3425: if $first is set to 'lastname' then it returns it as
                   3426: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3427: 
                   3428: =cut
1.61      www      3429: 
1.295     www      3430: 
1.81      albertel 3431: ###############################################################
1.61      www      3432: sub plainname {
1.226     albertel 3433:     my ($uname,$udom,$first)=@_;
1.537     albertel 3434:     return if (!defined($uname) || !defined($udom));
1.295     www      3435:     my %names=&getnames($uname,$udom);
1.226     albertel 3436:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3437: 					  $names{'middlename'},
                   3438: 					  $names{'lastname'},
                   3439: 					  $names{'generation'},$first);
                   3440:     $name=~s/^\s+//;
1.62      www      3441:     $name=~s/\s+$//;
                   3442:     $name=~s/\s+/ /g;
1.353     albertel 3443:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3444:     return $name;
1.61      www      3445: }
1.66      www      3446: 
                   3447: # -------------------------------------------------------------------- Nickname
1.81      albertel 3448: =pod
                   3449: 
1.648     raeburn  3450: =item * &nickname($uname,$udom)
1.81      albertel 3451: 
                   3452: Gets a users name and returns it as a string as
                   3453: 
                   3454: "&quot;nickname&quot;"
1.66      www      3455: 
1.81      albertel 3456: if the user has a nickname or
                   3457: 
                   3458: "first middle last generation"
                   3459: 
                   3460: if the user does not
                   3461: 
                   3462: =cut
1.66      www      3463: 
                   3464: sub nickname {
                   3465:     my ($uname,$udom)=@_;
1.537     albertel 3466:     return if (!defined($uname) || !defined($udom));
1.295     www      3467:     my %names=&getnames($uname,$udom);
1.68      albertel 3468:     my $name=$names{'nickname'};
1.66      www      3469:     if ($name) {
                   3470:        $name='&quot;'.$name.'&quot;'; 
                   3471:     } else {
                   3472:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3473: 	     $names{'lastname'}.' '.$names{'generation'};
                   3474:        $name=~s/\s+$//;
                   3475:        $name=~s/\s+/ /g;
                   3476:     }
                   3477:     return $name;
                   3478: }
                   3479: 
1.295     www      3480: sub getnames {
                   3481:     my ($uname,$udom)=@_;
1.537     albertel 3482:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3483:     if ($udom eq 'public' && $uname eq 'public') {
                   3484: 	return ('lastname' => &mt('Public'));
                   3485:     }
1.295     www      3486:     my $id=$uname.':'.$udom;
                   3487:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3488:     if ($cached) {
                   3489: 	return %{$names};
                   3490:     } else {
                   3491: 	my %loadnames=&Apache::lonnet::get('environment',
                   3492:                     ['firstname','middlename','lastname','generation','nickname'],
                   3493: 					 $udom,$uname);
                   3494: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3495: 	return %loadnames;
                   3496:     }
                   3497: }
1.61      www      3498: 
1.542     raeburn  3499: # -------------------------------------------------------------------- getemails
1.648     raeburn  3500: 
1.542     raeburn  3501: =pod
                   3502: 
1.648     raeburn  3503: =item * &getemails($uname,$udom)
1.542     raeburn  3504: 
                   3505: Gets a user's email information and returns it as a hash with keys:
                   3506: notification, critnotification, permanentemail
                   3507: 
                   3508: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3509: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3510:  
1.648     raeburn  3511: 
1.542     raeburn  3512: =cut
                   3513: 
1.648     raeburn  3514: 
1.466     albertel 3515: sub getemails {
                   3516:     my ($uname,$udom)=@_;
                   3517:     if ($udom eq 'public' && $uname eq 'public') {
                   3518: 	return;
                   3519:     }
1.467     www      3520:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3521:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3522:     my $id=$uname.':'.$udom;
                   3523:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3524:     if ($cached) {
                   3525: 	return %{$names};
                   3526:     } else {
                   3527: 	my %loadnames=&Apache::lonnet::get('environment',
                   3528:                     			   ['notification','critnotification',
                   3529: 					    'permanentemail'],
                   3530: 					   $udom,$uname);
                   3531: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3532: 	return %loadnames;
                   3533:     }
                   3534: }
                   3535: 
1.551     albertel 3536: sub flush_email_cache {
                   3537:     my ($uname,$udom)=@_;
                   3538:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3539:     if (!$uname) { $uname=$env{'user.name'};   }
                   3540:     return if ($udom eq 'public' && $uname eq 'public');
                   3541:     my $id=$uname.':'.$udom;
                   3542:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3543: }
                   3544: 
1.728     raeburn  3545: # -------------------------------------------------------------------- getlangs
                   3546: 
                   3547: =pod
                   3548: 
                   3549: =item * &getlangs($uname,$udom)
                   3550: 
                   3551: Gets a user's language preference and returns it as a hash with key:
                   3552: language.
                   3553: 
                   3554: =cut
                   3555: 
                   3556: 
                   3557: sub getlangs {
                   3558:     my ($uname,$udom) = @_;
                   3559:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3560:     if (!$uname) { $uname=$env{'user.name'};   }
                   3561:     my $id=$uname.':'.$udom;
                   3562:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3563:     if ($cached) {
                   3564:         return %{$langs};
                   3565:     } else {
                   3566:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3567:                                            $udom,$uname);
                   3568:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3569:         return %loadlangs;
                   3570:     }
                   3571: }
                   3572: 
                   3573: sub flush_langs_cache {
                   3574:     my ($uname,$udom)=@_;
                   3575:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3576:     if (!$uname) { $uname=$env{'user.name'};   }
                   3577:     return if ($udom eq 'public' && $uname eq 'public');
                   3578:     my $id=$uname.':'.$udom;
                   3579:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3580: }
                   3581: 
1.61      www      3582: # ------------------------------------------------------------------ Screenname
1.81      albertel 3583: 
                   3584: =pod
                   3585: 
1.648     raeburn  3586: =item * &screenname($uname,$udom)
1.81      albertel 3587: 
                   3588: Gets a users screenname and returns it as a string
                   3589: 
                   3590: =cut
1.61      www      3591: 
                   3592: sub screenname {
                   3593:     my ($uname,$udom)=@_;
1.258     albertel 3594:     if ($uname eq $env{'user.name'} &&
                   3595: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3596:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3597:     return $names{'screenname'};
1.62      www      3598: }
                   3599: 
1.212     albertel 3600: 
1.802     bisitz   3601: # ------------------------------------------------------------- Confirm Wrapper
                   3602: =pod
                   3603: 
1.1142    raeburn  3604: =item * &confirmwrapper($message)
1.802     bisitz   3605: 
                   3606: Wrap messages about completion of operation in box
                   3607: 
                   3608: =cut
                   3609: 
                   3610: sub confirmwrapper {
                   3611:     my ($message)=@_;
                   3612:     if ($message) {
                   3613:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3614:                .$message."\n"
                   3615:                .'</div>'."\n";
                   3616:     } else {
                   3617:         return $message;
                   3618:     }
                   3619: }
                   3620: 
1.62      www      3621: # ------------------------------------------------------------- Message Wrapper
                   3622: 
                   3623: sub messagewrapper {
1.369     www      3624:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3625:     return 
1.441     albertel 3626:         '<a href="/adm/email?compose=individual&amp;'.
                   3627:         'recname='.$username.'&amp;recdom='.$domain.
                   3628: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3629:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3630: }
1.802     bisitz   3631: 
1.74      www      3632: # --------------------------------------------------------------- Notes Wrapper
                   3633: 
                   3634: sub noteswrapper {
                   3635:     my ($link,$un,$do)=@_;
                   3636:     return 
1.896     amueller 3637: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3638: }
1.802     bisitz   3639: 
1.62      www      3640: # ------------------------------------------------------------- Aboutme Wrapper
                   3641: 
                   3642: sub aboutmewrapper {
1.1070    raeburn  3643:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3644:     if (!defined($username)  && !defined($domain)) {
                   3645:         return;
                   3646:     }
1.1096    raeburn  3647:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3648: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3649: }
                   3650: 
                   3651: # ------------------------------------------------------------ Syllabus Wrapper
                   3652: 
                   3653: sub syllabuswrapper {
1.707     bisitz   3654:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3655:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3656: }
1.14      harris41 3657: 
1.802     bisitz   3658: # -----------------------------------------------------------------------------
                   3659: 
1.208     matthew  3660: sub track_student_link {
1.887     raeburn  3661:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3662:     my $link ="/adm/trackstudent?";
1.208     matthew  3663:     my $title = 'View recent activity';
                   3664:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3665:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3666:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3667:         $title .= ' of this student';
1.268     albertel 3668:     } 
1.208     matthew  3669:     if (defined($target) && $target !~ /^\s*$/) {
                   3670:         $target = qq{target="$target"};
                   3671:     } else {
                   3672:         $target = '';
                   3673:     }
1.268     albertel 3674:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3675:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3676:     $title = &mt($title);
                   3677:     $linktext = &mt($linktext);
1.448     albertel 3678:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3679: 	&help_open_topic('View_recent_activity');
1.208     matthew  3680: }
                   3681: 
1.781     raeburn  3682: sub slot_reservations_link {
                   3683:     my ($linktext,$sname,$sdom,$target) = @_;
                   3684:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3685:     my $title = 'View slot reservation history';
                   3686:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3687:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3688:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3689:         $title .= ' of this student';
                   3690:     }
                   3691:     if (defined($target) && $target !~ /^\s*$/) {
                   3692:         $target = qq{target="$target"};
                   3693:     } else {
                   3694:         $target = '';
                   3695:     }
                   3696:     $title = &mt($title);
                   3697:     $linktext = &mt($linktext);
                   3698:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3699: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3700: 
                   3701: }
                   3702: 
1.508     www      3703: # ===================================================== Display a student photo
                   3704: 
                   3705: 
1.509     albertel 3706: sub student_image_tag {
1.508     www      3707:     my ($domain,$user)=@_;
                   3708:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3709:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3710: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3711:     } else {
                   3712: 	return '';
                   3713:     }
                   3714: }
                   3715: 
1.112     bowersj2 3716: =pod
                   3717: 
                   3718: =back
                   3719: 
                   3720: =head1 Access .tab File Data
                   3721: 
                   3722: =over 4
                   3723: 
1.648     raeburn  3724: =item * &languageids() 
1.112     bowersj2 3725: 
                   3726: returns list of all language ids
                   3727: 
                   3728: =cut
                   3729: 
1.14      harris41 3730: sub languageids {
1.16      harris41 3731:     return sort(keys(%language));
1.14      harris41 3732: }
                   3733: 
1.112     bowersj2 3734: =pod
                   3735: 
1.648     raeburn  3736: =item * &languagedescription() 
1.112     bowersj2 3737: 
                   3738: returns description of a specified language id
                   3739: 
                   3740: =cut
                   3741: 
1.14      harris41 3742: sub languagedescription {
1.125     www      3743:     my $code=shift;
                   3744:     return  ($supported_language{$code}?'* ':'').
                   3745:             $language{$code}.
1.126     www      3746: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3747: }
                   3748: 
1.1048    foxr     3749: =pod
                   3750: 
                   3751: =item * &plainlanguagedescription
                   3752: 
                   3753: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3754: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3755: 
                   3756: =cut
                   3757: 
1.145     www      3758: sub plainlanguagedescription {
                   3759:     my $code=shift;
                   3760:     return $language{$code};
                   3761: }
                   3762: 
1.1048    foxr     3763: =pod
                   3764: 
                   3765: =item * &supportedlanguagecode
                   3766: 
                   3767: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3768: code.
                   3769: 
                   3770: =cut
                   3771: 
1.145     www      3772: sub supportedlanguagecode {
                   3773:     my $code=shift;
                   3774:     return $supported_language{$code};
1.97      www      3775: }
                   3776: 
1.112     bowersj2 3777: =pod
                   3778: 
1.1048    foxr     3779: =item * &latexlanguage()
                   3780: 
                   3781: Given a language key code returns the correspondnig language to use
                   3782: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3783: is no supported hyphenation for the language code.
                   3784: 
                   3785: =cut
                   3786: 
                   3787: sub latexlanguage {
                   3788:     my $code = shift;
                   3789:     return $latex_language{$code};
                   3790: }
                   3791: 
                   3792: =pod
                   3793: 
                   3794: =item * &latexhyphenation()
                   3795: 
                   3796: Same as above but what's supplied is the language as it might be stored
                   3797: in the metadata.
                   3798: 
                   3799: =cut
                   3800: 
                   3801: sub latexhyphenation {
                   3802:     my $key = shift;
                   3803:     return $latex_language_bykey{$key};
                   3804: }
                   3805: 
                   3806: =pod
                   3807: 
1.648     raeburn  3808: =item * &copyrightids() 
1.112     bowersj2 3809: 
                   3810: returns list of all copyrights
                   3811: 
                   3812: =cut
                   3813: 
                   3814: sub copyrightids {
                   3815:     return sort(keys(%cprtag));
                   3816: }
                   3817: 
                   3818: =pod
                   3819: 
1.648     raeburn  3820: =item * &copyrightdescription() 
1.112     bowersj2 3821: 
                   3822: returns description of a specified copyright id
                   3823: 
                   3824: =cut
                   3825: 
                   3826: sub copyrightdescription {
1.166     www      3827:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3828: }
1.197     matthew  3829: 
                   3830: =pod
                   3831: 
1.648     raeburn  3832: =item * &source_copyrightids() 
1.192     taceyjo1 3833: 
                   3834: returns list of all source copyrights
                   3835: 
                   3836: =cut
                   3837: 
                   3838: sub source_copyrightids {
                   3839:     return sort(keys(%scprtag));
                   3840: }
                   3841: 
                   3842: =pod
                   3843: 
1.648     raeburn  3844: =item * &source_copyrightdescription() 
1.192     taceyjo1 3845: 
                   3846: returns description of a specified source copyright id
                   3847: 
                   3848: =cut
                   3849: 
                   3850: sub source_copyrightdescription {
                   3851:     return &mt($scprtag{shift(@_)});
                   3852: }
1.112     bowersj2 3853: 
                   3854: =pod
                   3855: 
1.648     raeburn  3856: =item * &filecategories() 
1.112     bowersj2 3857: 
                   3858: returns list of all file categories
                   3859: 
                   3860: =cut
                   3861: 
                   3862: sub filecategories {
                   3863:     return sort(keys(%category_extensions));
                   3864: }
                   3865: 
                   3866: =pod
                   3867: 
1.648     raeburn  3868: =item * &filecategorytypes() 
1.112     bowersj2 3869: 
                   3870: returns list of file types belonging to a given file
                   3871: category
                   3872: 
                   3873: =cut
                   3874: 
                   3875: sub filecategorytypes {
1.356     albertel 3876:     my ($cat) = @_;
                   3877:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3878: }
                   3879: 
                   3880: =pod
                   3881: 
1.648     raeburn  3882: =item * &fileembstyle() 
1.112     bowersj2 3883: 
                   3884: returns embedding style for a specified file type
                   3885: 
                   3886: =cut
                   3887: 
                   3888: sub fileembstyle {
                   3889:     return $fe{lc(shift(@_))};
1.169     www      3890: }
                   3891: 
1.351     www      3892: sub filemimetype {
                   3893:     return $fm{lc(shift(@_))};
                   3894: }
                   3895: 
1.169     www      3896: 
                   3897: sub filecategoryselect {
                   3898:     my ($name,$value)=@_;
1.189     matthew  3899:     return &select_form($value,$name,
1.970     raeburn  3900:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3901: }
                   3902: 
                   3903: =pod
                   3904: 
1.648     raeburn  3905: =item * &filedescription() 
1.112     bowersj2 3906: 
                   3907: returns description for a specified file type
                   3908: 
                   3909: =cut
                   3910: 
                   3911: sub filedescription {
1.188     matthew  3912:     my $file_description = $fd{lc(shift())};
                   3913:     $file_description =~ s:([\[\]]):~$1:g;
                   3914:     return &mt($file_description);
1.112     bowersj2 3915: }
                   3916: 
                   3917: =pod
                   3918: 
1.648     raeburn  3919: =item * &filedescriptionex() 
1.112     bowersj2 3920: 
                   3921: returns description for a specified file type with
                   3922: extra formatting
                   3923: 
                   3924: =cut
                   3925: 
                   3926: sub filedescriptionex {
                   3927:     my $ex=shift;
1.188     matthew  3928:     my $file_description = $fd{lc($ex)};
                   3929:     $file_description =~ s:([\[\]]):~$1:g;
                   3930:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3931: }
                   3932: 
                   3933: # End of .tab access
                   3934: =pod
                   3935: 
                   3936: =back
                   3937: 
                   3938: =cut
                   3939: 
                   3940: # ------------------------------------------------------------------ File Types
                   3941: sub fileextensions {
                   3942:     return sort(keys(%fe));
                   3943: }
                   3944: 
1.97      www      3945: # ----------------------------------------------------------- Display Languages
                   3946: # returns a hash with all desired display languages
                   3947: #
                   3948: 
                   3949: sub display_languages {
                   3950:     my %languages=();
1.695     raeburn  3951:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3952: 	$languages{$lang}=1;
1.97      www      3953:     }
                   3954:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3955:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3956: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3957: 	    $languages{$lang}=1;
1.97      www      3958:         }
                   3959:     }
                   3960:     return %languages;
1.14      harris41 3961: }
                   3962: 
1.582     albertel 3963: sub languages {
                   3964:     my ($possible_langs) = @_;
1.695     raeburn  3965:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3966:     if (!ref($possible_langs)) {
                   3967: 	if( wantarray ) {
                   3968: 	    return @preferred_langs;
                   3969: 	} else {
                   3970: 	    return $preferred_langs[0];
                   3971: 	}
                   3972:     }
                   3973:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3974:     my @preferred_possibilities;
                   3975:     foreach my $preferred_lang (@preferred_langs) {
                   3976: 	if (exists($possibilities{$preferred_lang})) {
                   3977: 	    push(@preferred_possibilities, $preferred_lang);
                   3978: 	}
                   3979:     }
                   3980:     if( wantarray ) {
                   3981: 	return @preferred_possibilities;
                   3982:     }
                   3983:     return $preferred_possibilities[0];
                   3984: }
                   3985: 
1.742     raeburn  3986: sub user_lang {
                   3987:     my ($touname,$toudom,$fromcid) = @_;
                   3988:     my @userlangs;
                   3989:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3990:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3991:                     $env{'course.'.$fromcid.'.languages'}));
                   3992:     } else {
                   3993:         my %langhash = &getlangs($touname,$toudom);
                   3994:         if ($langhash{'languages'} ne '') {
                   3995:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3996:         } else {
                   3997:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3998:             if ($domdefs{'lang_def'} ne '') {
                   3999:                 @userlangs = ($domdefs{'lang_def'});
                   4000:             }
                   4001:         }
                   4002:     }
                   4003:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4004:     my $user_lh = Apache::localize->get_handle(@languages);
                   4005:     return $user_lh;
                   4006: }
                   4007: 
                   4008: 
1.112     bowersj2 4009: ###############################################################
                   4010: ##               Student Answer Attempts                     ##
                   4011: ###############################################################
                   4012: 
                   4013: =pod
                   4014: 
                   4015: =head1 Alternate Problem Views
                   4016: 
                   4017: =over 4
                   4018: 
1.648     raeburn  4019: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199    raeburn  4020:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4021: 
                   4022: Return string with previous attempt on problem. Arguments:
                   4023: 
                   4024: =over 4
                   4025: 
                   4026: =item * $symb: Problem, including path
                   4027: 
                   4028: =item * $username: username of the desired student
                   4029: 
                   4030: =item * $domain: domain of the desired student
1.14      harris41 4031: 
1.112     bowersj2 4032: =item * $course: Course ID
1.14      harris41 4033: 
1.112     bowersj2 4034: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4035:     something
1.14      harris41 4036: 
1.112     bowersj2 4037: =item * $regexp: if string matches this regexp, the string will be
                   4038:     sent to $gradesub
1.14      harris41 4039: 
1.112     bowersj2 4040: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4041: 
1.1199    raeburn  4042: =item * $usec: section of the desired student
                   4043: 
                   4044: =item * $identifier: counter for student (multiple students one problem) or 
                   4045:     problem (one student; whole sequence).
                   4046: 
1.112     bowersj2 4047: =back
1.14      harris41 4048: 
1.112     bowersj2 4049: The output string is a table containing all desired attempts, if any.
1.16      harris41 4050: 
1.112     bowersj2 4051: =cut
1.1       albertel 4052: 
                   4053: sub get_previous_attempt {
1.1199    raeburn  4054:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4055:   my $prevattempts='';
1.43      ng       4056:   no strict 'refs';
1.1       albertel 4057:   if ($symb) {
1.3       albertel 4058:     my (%returnhash)=
                   4059:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4060:     if ($returnhash{'version'}) {
                   4061:       my %lasthash=();
                   4062:       my $version;
                   4063:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212    raeburn  4064:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4065:             if ($key =~ /\.rawrndseed$/) {
                   4066:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4067:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4068:             } else {
                   4069:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4070:             }
1.19      harris41 4071:         }
1.1       albertel 4072:       }
1.596     albertel 4073:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4074:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1199    raeburn  4075:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4076:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4077:       foreach my $key (sort(keys(%lasthash))) {
                   4078: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4079: 	if ($#parts > 0) {
1.31      albertel 4080: 	  my $data=$parts[-1];
1.989     raeburn  4081:           next if ($data eq 'foilorder');
1.31      albertel 4082: 	  pop(@parts);
1.1010    www      4083:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4084:           if ($data eq 'type') {
                   4085:               unless ($showsurv) {
                   4086:                   my $id = join(',',@parts);
                   4087:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4088:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4089:                       $lasthidden{$ign.'.'.$id} = 1;
                   4090:                   }
1.945     raeburn  4091:               }
1.1199    raeburn  4092:               if ($identifier ne '') {
                   4093:                   my $id = join(',',@parts);
                   4094:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4095:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4096:                       $hidestatus{$ign.'.'.$id} = 1;
                   4097:                   }
                   4098:               }
                   4099:           } elsif ($data eq 'regrader') {
                   4100:               if (($identifier ne '') && (@parts)) {
1.1200    raeburn  4101:                   my $id = join(',',@parts);
                   4102:                   $regraded{$ign.'.'.$id} = 1;
1.1199    raeburn  4103:               }
1.1010    www      4104:           } 
1.31      albertel 4105: 	} else {
1.41      ng       4106: 	  if ($#parts == 0) {
                   4107: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4108: 	  } else {
                   4109: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4110: 	  }
1.31      albertel 4111: 	}
1.16      harris41 4112:       }
1.596     albertel 4113:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4114:       if ($getattempt eq '') {
1.1199    raeburn  4115:         my (%solved,%resets,%probstatus);
1.1200    raeburn  4116:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4117:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4118:                 foreach my $id (keys(%regraded)) {
                   4119:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4120:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4121:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4122:                         push(@{$resets{$id}},$version);
1.1199    raeburn  4123:                     }
                   4124:                 }
                   4125:             }
1.1200    raeburn  4126:         }
                   4127: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199    raeburn  4128:             my (@hidden,@unsolved);
1.945     raeburn  4129:             if (%typeparts) {
                   4130:                 foreach my $id (keys(%typeparts)) {
1.1199    raeburn  4131:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                   4132:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4133:                         push(@hidden,$id);
1.1199    raeburn  4134:                     } elsif ($identifier ne '') {
                   4135:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4136:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4137:                                 ($hidestatus{$id})) {
1.1200    raeburn  4138:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199    raeburn  4139:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4140:                                 push(@{$solved{$id}},$version);
                   4141:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4142:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4143:                                 my $skip;
                   4144:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4145:                                     foreach my $reset (@{$resets{$id}}) {
                   4146:                                         if ($reset > $solved{$id}[-1]) {
                   4147:                                             $skip=1;
                   4148:                                             last;
                   4149:                                         }
                   4150:                                     }
                   4151:                                 }
                   4152:                                 unless ($skip) {
                   4153:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4154:                                     push(@unsolved,$partslist);
                   4155:                                 }
                   4156:                             }
                   4157:                         }
1.945     raeburn  4158:                     }
                   4159:                 }
                   4160:             }
                   4161:             $prevattempts.=&start_data_table_row().
1.1199    raeburn  4162:                            '<td>'.&mt('Transaction [_1]',$version);
                   4163:             if (@unsolved) {
                   4164:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4165:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4166:                                  &mt('Hide').'</label></span>';
                   4167:             }
                   4168:             $prevattempts .= '</td>';
1.945     raeburn  4169:             if (@hidden) {
                   4170:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4171:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4172:                     my $hide;
                   4173:                     foreach my $id (@hidden) {
                   4174:                         if ($key =~ /^\Q$id\E/) {
                   4175:                             $hide = 1;
                   4176:                             last;
                   4177:                         }
                   4178:                     }
                   4179:                     if ($hide) {
                   4180:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4181:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4182:                             my $value = &format_previous_attempt_value($key,
                   4183:                                              $returnhash{$version.':'.$key});
1.1173    kruse    4184:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4185:                         } else {
                   4186:                             $prevattempts.='<td>&nbsp;</td>';
                   4187:                         }
                   4188:                     } else {
                   4189:                         if ($key =~ /\./) {
1.1212    raeburn  4190:                             my $value = $returnhash{$version.':'.$key};
                   4191:                             if ($key =~ /\.rndseed$/) {
                   4192:                                 my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4193:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4194:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4195:                                 }
                   4196:                             }
                   4197:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4198:                                            '&nbsp;</td>';
1.945     raeburn  4199:                         } else {
                   4200:                             $prevattempts.='<td>&nbsp;</td>';
                   4201:                         }
                   4202:                     }
                   4203:                 }
                   4204:             } else {
                   4205: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4206:                     next if ($key =~ /\.foilorder$/);
1.1212    raeburn  4207:                     my $value = $returnhash{$version.':'.$key};
                   4208:                     if ($key =~ /\.rndseed$/) {
                   4209:                         my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4210:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4211:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4212:                         }
                   4213:                     }
                   4214:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4215:                                    '&nbsp;</td>';
1.945     raeburn  4216: 	        }
                   4217:             }
                   4218: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4219: 	 }
1.1       albertel 4220:       }
1.945     raeburn  4221:       my @currhidden = keys(%lasthidden);
1.596     albertel 4222:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4223:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4224:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4225:           if (%typeparts) {
                   4226:               my $hidden;
                   4227:               foreach my $id (@currhidden) {
                   4228:                   if ($key =~ /^\Q$id\E/) {
                   4229:                       $hidden = 1;
                   4230:                       last;
                   4231:                   }
                   4232:               }
                   4233:               if ($hidden) {
                   4234:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4235:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4236:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4237:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4238:                           $value = &$gradesub($value);
                   4239:                       }
1.1173    kruse    4240:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  4241:                   } else {
                   4242:                       $prevattempts.='<td>&nbsp;</td>';
                   4243:                   }
                   4244:               } else {
                   4245:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4246:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4247:                       $value = &$gradesub($value);
                   4248:                   }
1.1173    kruse    4249:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4250:               }
                   4251:           } else {
                   4252: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4253: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4254:                   $value = &$gradesub($value);
                   4255:               }
1.1173    kruse    4256: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4257:           }
1.16      harris41 4258:       }
1.596     albertel 4259:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4260:     } else {
1.596     albertel 4261:       $prevattempts=
                   4262: 	  &start_data_table().&start_data_table_row().
                   4263: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   4264: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4265:     }
                   4266:   } else {
1.596     albertel 4267:     $prevattempts=
                   4268: 	  &start_data_table().&start_data_table_row().
                   4269: 	  '<td>'.&mt('No data.').'</td>'.
                   4270: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4271:   }
1.10      albertel 4272: }
                   4273: 
1.581     albertel 4274: sub format_previous_attempt_value {
                   4275:     my ($key,$value) = @_;
1.1011    www      4276:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    4277:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 4278:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    4279:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  4280:     } elsif ($key =~ /answerstring$/) {
                   4281:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    4282:         my @answer = %answers;
                   4283:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  4284:         my @anskeys = sort(keys(%answers));
                   4285:         if (@anskeys == 1) {
                   4286:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4287:             if ($answer =~ m{\0}) {
                   4288:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4289:             }
                   4290:             my $tag_internal_answer_name = 'INTERNAL';
                   4291:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4292:                 $value = $answer; 
                   4293:             } else {
                   4294:                 $value = $anskeys[0].'='.$answer;
                   4295:             }
                   4296:         } else {
                   4297:             foreach my $ans (@anskeys) {
                   4298:                 my $answer = $answers{$ans};
1.1001    raeburn  4299:                 if ($answer =~ m{\0}) {
                   4300:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4301:                 }
                   4302:                 $value .=  $ans.'='.$answer.'<br />';;
                   4303:             } 
                   4304:         }
1.581     albertel 4305:     } else {
1.1173    kruse    4306:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 4307:     }
                   4308:     return $value;
                   4309: }
                   4310: 
                   4311: 
1.107     albertel 4312: sub relative_to_absolute {
                   4313:     my ($url,$output)=@_;
                   4314:     my $parser=HTML::TokeParser->new(\$output);
                   4315:     my $token;
                   4316:     my $thisdir=$url;
                   4317:     my @rlinks=();
                   4318:     while ($token=$parser->get_token) {
                   4319: 	if ($token->[0] eq 'S') {
                   4320: 	    if ($token->[1] eq 'a') {
                   4321: 		if ($token->[2]->{'href'}) {
                   4322: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4323: 		}
                   4324: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4325: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4326: 	    } elsif ($token->[1] eq 'base') {
                   4327: 		$thisdir=$token->[2]->{'href'};
                   4328: 	    }
                   4329: 	}
                   4330:     }
                   4331:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4332:     foreach my $link (@rlinks) {
1.726     raeburn  4333: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4334: 		($link=~/^\//) ||
                   4335: 		($link=~/^javascript:/i) ||
                   4336: 		($link=~/^mailto:/i) ||
                   4337: 		($link=~/^\#/)) {
                   4338: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4339: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4340: 	}
                   4341:     }
                   4342: # -------------------------------------------------- Deal with Applet codebases
                   4343:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4344:     return $output;
                   4345: }
                   4346: 
1.112     bowersj2 4347: =pod
                   4348: 
1.648     raeburn  4349: =item * &get_student_view()
1.112     bowersj2 4350: 
                   4351: show a snapshot of what student was looking at
                   4352: 
                   4353: =cut
                   4354: 
1.10      albertel 4355: sub get_student_view {
1.186     albertel 4356:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4357:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4358:   my (%form);
1.10      albertel 4359:   my @elements=('symb','courseid','domain','username');
                   4360:   foreach my $element (@elements) {
1.186     albertel 4361:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4362:   }
1.186     albertel 4363:   if (defined($moreenv)) {
                   4364:       %form=(%form,%{$moreenv});
                   4365:   }
1.236     albertel 4366:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4367:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4368:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4369:   $userview=~s/\<body[^\>]*\>//gi;
                   4370:   $userview=~s/\<\/body\>//gi;
                   4371:   $userview=~s/\<html\>//gi;
                   4372:   $userview=~s/\<\/html\>//gi;
                   4373:   $userview=~s/\<head\>//gi;
                   4374:   $userview=~s/\<\/head\>//gi;
                   4375:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4376:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4377:   if (wantarray) {
                   4378:      return ($userview,$response);
                   4379:   } else {
                   4380:      return $userview;
                   4381:   }
                   4382: }
                   4383: 
                   4384: sub get_student_view_with_retries {
                   4385:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4386: 
                   4387:     my $ok = 0;                 # True if we got a good response.
                   4388:     my $content;
                   4389:     my $response;
                   4390: 
                   4391:     # Try to get the student_view done. within the retries count:
                   4392:     
                   4393:     do {
                   4394:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4395:          $ok      = $response->is_success;
                   4396:          if (!$ok) {
                   4397:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4398:          }
                   4399:          $retries--;
                   4400:     } while (!$ok && ($retries > 0));
                   4401:     
                   4402:     if (!$ok) {
                   4403:        $content = '';          # On error return an empty content.
                   4404:     }
1.651     www      4405:     if (wantarray) {
                   4406:        return ($content, $response);
                   4407:     } else {
                   4408:        return $content;
                   4409:     }
1.11      albertel 4410: }
                   4411: 
1.112     bowersj2 4412: =pod
                   4413: 
1.648     raeburn  4414: =item * &get_student_answers() 
1.112     bowersj2 4415: 
                   4416: show a snapshot of how student was answering problem
                   4417: 
                   4418: =cut
                   4419: 
1.11      albertel 4420: sub get_student_answers {
1.100     sakharuk 4421:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4422:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4423:   my (%moreenv);
1.11      albertel 4424:   my @elements=('symb','courseid','domain','username');
                   4425:   foreach my $element (@elements) {
1.186     albertel 4426:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4427:   }
1.186     albertel 4428:   $moreenv{'grade_target'}='answer';
                   4429:   %moreenv=(%form,%moreenv);
1.497     raeburn  4430:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4431:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4432:   return $userview;
1.1       albertel 4433: }
1.116     albertel 4434: 
                   4435: =pod
                   4436: 
                   4437: =item * &submlink()
                   4438: 
1.242     albertel 4439: Inputs: $text $uname $udom $symb $target
1.116     albertel 4440: 
                   4441: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4442: 
                   4443: =cut
                   4444: 
                   4445: ###############################################
                   4446: sub submlink {
1.242     albertel 4447:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4448:     if (!($uname && $udom)) {
                   4449: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4450: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4451: 	if (!$symb) { $symb=$cursymb; }
                   4452:     }
1.254     matthew  4453:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4454:     $symb=&escape($symb);
1.960     bisitz   4455:     if ($target) { $target=" target=\"$target\""; }
                   4456:     return
                   4457:         '<a href="/adm/grades?command=submission'.
                   4458:         '&amp;symb='.$symb.
                   4459:         '&amp;student='.$uname.
                   4460:         '&amp;userdom='.$udom.'"'.
                   4461:         $target.'>'.$text.'</a>';
1.242     albertel 4462: }
                   4463: ##############################################
                   4464: 
                   4465: =pod
                   4466: 
                   4467: =item * &pgrdlink()
                   4468: 
                   4469: Inputs: $text $uname $udom $symb $target
                   4470: 
                   4471: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4472: 
                   4473: =cut
                   4474: 
                   4475: ###############################################
                   4476: sub pgrdlink {
                   4477:     my $link=&submlink(@_);
                   4478:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4479:     return $link;
                   4480: }
                   4481: ##############################################
                   4482: 
                   4483: =pod
                   4484: 
                   4485: =item * &pprmlink()
                   4486: 
                   4487: Inputs: $text $uname $udom $symb $target
                   4488: 
                   4489: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4490: student and a specific resource
1.242     albertel 4491: 
                   4492: =cut
                   4493: 
                   4494: ###############################################
                   4495: sub pprmlink {
                   4496:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4497:     if (!($uname && $udom)) {
                   4498: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4499: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4500: 	if (!$symb) { $symb=$cursymb; }
                   4501:     }
1.254     matthew  4502:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4503:     $symb=&escape($symb);
1.242     albertel 4504:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4505:     return '<a href="/adm/parmset?command=set&amp;'.
                   4506: 	'symb='.$symb.'&amp;uname='.$uname.
                   4507: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4508: }
                   4509: ##############################################
1.37      matthew  4510: 
1.112     bowersj2 4511: =pod
                   4512: 
                   4513: =back
                   4514: 
                   4515: =cut
                   4516: 
1.37      matthew  4517: ###############################################
1.51      www      4518: 
                   4519: 
                   4520: sub timehash {
1.687     raeburn  4521:     my ($thistime) = @_;
                   4522:     my $timezone = &Apache::lonlocal::gettimezone();
                   4523:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4524:                      ->set_time_zone($timezone);
                   4525:     my $wday = $dt->day_of_week();
                   4526:     if ($wday == 7) { $wday = 0; }
                   4527:     return ( 'second' => $dt->second(),
                   4528:              'minute' => $dt->minute(),
                   4529:              'hour'   => $dt->hour(),
                   4530:              'day'     => $dt->day_of_month(),
                   4531:              'month'   => $dt->month(),
                   4532:              'year'    => $dt->year(),
                   4533:              'weekday' => $wday,
                   4534:              'dayyear' => $dt->day_of_year(),
                   4535:              'dlsav'   => $dt->is_dst() );
1.51      www      4536: }
                   4537: 
1.370     www      4538: sub utc_string {
                   4539:     my ($date)=@_;
1.371     www      4540:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4541: }
                   4542: 
1.51      www      4543: sub maketime {
                   4544:     my %th=@_;
1.687     raeburn  4545:     my ($epoch_time,$timezone,$dt);
                   4546:     $timezone = &Apache::lonlocal::gettimezone();
                   4547:     eval {
                   4548:         $dt = DateTime->new( year   => $th{'year'},
                   4549:                              month  => $th{'month'},
                   4550:                              day    => $th{'day'},
                   4551:                              hour   => $th{'hour'},
                   4552:                              minute => $th{'minute'},
                   4553:                              second => $th{'second'},
                   4554:                              time_zone => $timezone,
                   4555:                          );
                   4556:     };
                   4557:     if (!$@) {
                   4558:         $epoch_time = $dt->epoch;
                   4559:         if ($epoch_time) {
                   4560:             return $epoch_time;
                   4561:         }
                   4562:     }
1.51      www      4563:     return POSIX::mktime(
                   4564:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4565:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4566: }
                   4567: 
                   4568: #########################################
1.51      www      4569: 
                   4570: sub findallcourses {
1.482     raeburn  4571:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4572:     my %roles;
                   4573:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4574:     my %courses;
1.51      www      4575:     my $now=time;
1.482     raeburn  4576:     if (!defined($uname)) {
                   4577:         $uname = $env{'user.name'};
                   4578:     }
                   4579:     if (!defined($udom)) {
                   4580:         $udom = $env{'user.domain'};
                   4581:     }
                   4582:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4583:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4584:         if (!%roles) {
                   4585:             %roles = (
                   4586:                        cc => 1,
1.907     raeburn  4587:                        co => 1,
1.482     raeburn  4588:                        in => 1,
                   4589:                        ep => 1,
                   4590:                        ta => 1,
                   4591:                        cr => 1,
                   4592:                        st => 1,
                   4593:              );
                   4594:         }
                   4595:         foreach my $entry (keys(%roleshash)) {
                   4596:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4597:             if ($trole =~ /^cr/) { 
                   4598:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4599:             } else {
                   4600:                 next if (!exists($roles{$trole}));
                   4601:             }
                   4602:             if ($tend) {
                   4603:                 next if ($tend < $now);
                   4604:             }
                   4605:             if ($tstart) {
                   4606:                 next if ($tstart > $now);
                   4607:             }
1.1058    raeburn  4608:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4609:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4610:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4611:             if ($secpart eq '') {
                   4612:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4613:                 $sec = 'none';
1.1058    raeburn  4614:                 $value .= $cnum.'/';
1.482     raeburn  4615:             } else {
                   4616:                 $cnum = $cnumpart;
                   4617:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4618:                 $value .= $cnum.'/'.$sec;
                   4619:             }
                   4620:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4621:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4622:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4623:                 }
                   4624:             } else {
                   4625:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4626:             }
1.482     raeburn  4627:         }
                   4628:     } else {
                   4629:         foreach my $key (keys(%env)) {
1.483     albertel 4630: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4631:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4632: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4633: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4634: 	        next if (%roles && !exists($roles{$role}));
                   4635: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4636:                 my $active=1;
                   4637:                 if ($starttime) {
                   4638: 		    if ($now<$starttime) { $active=0; }
                   4639:                 }
                   4640:                 if ($endtime) {
                   4641:                     if ($now>$endtime) { $active=0; }
                   4642:                 }
                   4643:                 if ($active) {
1.1058    raeburn  4644:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4645:                     if ($sec eq '') {
                   4646:                         $sec = 'none';
1.1058    raeburn  4647:                     } else {
                   4648:                         $value .= $sec;
                   4649:                     }
                   4650:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4651:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4652:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4653:                         }
                   4654:                     } else {
                   4655:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4656:                     }
1.474     raeburn  4657:                 }
                   4658:             }
1.51      www      4659:         }
                   4660:     }
1.474     raeburn  4661:     return %courses;
1.51      www      4662: }
1.37      matthew  4663: 
1.54      www      4664: ###############################################
1.474     raeburn  4665: 
                   4666: sub blockcheck {
1.1189    raeburn  4667:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4668: 
1.1189    raeburn  4669:     if (defined($udom) && defined($uname)) {
                   4670:         # If uname and udom are for a course, check for blocks in the course.
                   4671:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4672:             my ($startblock,$endblock,$triggerblock) =
                   4673:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4674:             return ($startblock,$endblock,$triggerblock);
                   4675:         }
                   4676:     } else {
1.490     raeburn  4677:         $udom = $env{'user.domain'};
                   4678:         $uname = $env{'user.name'};
                   4679:     }
                   4680: 
1.502     raeburn  4681:     my $startblock = 0;
                   4682:     my $endblock = 0;
1.1062    raeburn  4683:     my $triggerblock = '';
1.482     raeburn  4684:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4685: 
1.490     raeburn  4686:     # If uname is for a user, and activity is course-specific, i.e.,
                   4687:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4688: 
1.490     raeburn  4689:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189    raeburn  4690:          $activity eq 'groups' || $activity eq 'printout') &&
                   4691:         ($env{'request.course.id'})) {
1.490     raeburn  4692:         foreach my $key (keys(%live_courses)) {
                   4693:             if ($key ne $env{'request.course.id'}) {
                   4694:                 delete($live_courses{$key});
                   4695:             }
                   4696:         }
                   4697:     }
                   4698: 
                   4699:     my $otheruser = 0;
                   4700:     my %own_courses;
                   4701:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4702:         # Resource belongs to user other than current user.
                   4703:         $otheruser = 1;
                   4704:         # Gather courses for current user
                   4705:         %own_courses = 
                   4706:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4707:     }
                   4708: 
                   4709:     # Gather active course roles - course coordinator, instructor, 
                   4710:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4711: 
                   4712:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4713:         my ($cdom,$cnum);
                   4714:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4715:             $cdom = $env{'course.'.$course.'.domain'};
                   4716:             $cnum = $env{'course.'.$course.'.num'};
                   4717:         } else {
1.490     raeburn  4718:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4719:         }
                   4720:         my $no_ownblock = 0;
                   4721:         my $no_userblock = 0;
1.533     raeburn  4722:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4723:             # Check if current user has 'evb' priv for this
                   4724:             if (defined($own_courses{$course})) {
                   4725:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4726:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4727:                     if ($sec ne 'none') {
                   4728:                         $checkrole .= '/'.$sec;
                   4729:                     }
                   4730:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4731:                         $no_ownblock = 1;
                   4732:                         last;
                   4733:                     }
                   4734:                 }
                   4735:             }
                   4736:             # if they have 'evb' priv and are currently not playing student
                   4737:             next if (($no_ownblock) &&
                   4738:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4739:         }
1.474     raeburn  4740:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4741:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4742:             if ($sec ne 'none') {
1.482     raeburn  4743:                 $checkrole .= '/'.$sec;
1.474     raeburn  4744:             }
1.490     raeburn  4745:             if ($otheruser) {
                   4746:                 # Resource belongs to user other than current user.
                   4747:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4748:                 my (%allroles,%userroles);
                   4749:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4750:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4751:                         my ($trole,$tdom,$tnum,$tsec);
                   4752:                         if ($entry =~ /^cr/) {
                   4753:                             ($trole,$tdom,$tnum,$tsec) = 
                   4754:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4755:                         } else {
                   4756:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4757:                         }
                   4758:                         my ($spec,$area,$trest);
                   4759:                         $area = '/'.$tdom.'/'.$tnum;
                   4760:                         $trest = $tnum;
                   4761:                         if ($tsec ne '') {
                   4762:                             $area .= '/'.$tsec;
                   4763:                             $trest .= '/'.$tsec;
                   4764:                         }
                   4765:                         $spec = $trole.'.'.$area;
                   4766:                         if ($trole =~ /^cr/) {
                   4767:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4768:                                                               $tdom,$spec,$trest,$area);
                   4769:                         } else {
                   4770:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4771:                                                                 $tdom,$spec,$trest,$area);
                   4772:                         }
                   4773:                     }
                   4774:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4775:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4776:                         if ($1) {
                   4777:                             $no_userblock = 1;
                   4778:                             last;
                   4779:                         }
1.486     raeburn  4780:                     }
                   4781:                 }
1.490     raeburn  4782:             } else {
                   4783:                 # Resource belongs to current user
                   4784:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4785:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4786:                     $no_ownblock = 1;
                   4787:                     last;
                   4788:                 }
1.474     raeburn  4789:             }
                   4790:         }
                   4791:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4792:         next if (($no_ownblock) &&
1.491     albertel 4793:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4794:         next if ($no_userblock);
1.474     raeburn  4795: 
1.866     kalberla 4796:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4797:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4798:         
1.1062    raeburn  4799:         my ($start,$end,$trigger) = 
                   4800:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4801:         if (($start != 0) && 
                   4802:             (($startblock == 0) || ($startblock > $start))) {
                   4803:             $startblock = $start;
1.1062    raeburn  4804:             if ($trigger ne '') {
                   4805:                 $triggerblock = $trigger;
                   4806:             }
1.502     raeburn  4807:         }
                   4808:         if (($end != 0)  &&
                   4809:             (($endblock == 0) || ($endblock < $end))) {
                   4810:             $endblock = $end;
1.1062    raeburn  4811:             if ($trigger ne '') {
                   4812:                 $triggerblock = $trigger;
                   4813:             }
1.502     raeburn  4814:         }
1.490     raeburn  4815:     }
1.1062    raeburn  4816:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4817: }
                   4818: 
                   4819: sub get_blocks {
1.1062    raeburn  4820:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4821:     my $startblock = 0;
                   4822:     my $endblock = 0;
1.1062    raeburn  4823:     my $triggerblock = '';
1.490     raeburn  4824:     my $course = $cdom.'_'.$cnum;
                   4825:     $setters->{$course} = {};
                   4826:     $setters->{$course}{'staff'} = [];
                   4827:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4828:     $setters->{$course}{'triggers'} = [];
                   4829:     my (@blockers,%triggered);
                   4830:     my $now = time;
                   4831:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4832:     if ($activity eq 'docs') {
                   4833:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4834:         foreach my $block (@blockers) {
                   4835:             if ($block =~ /^firstaccess____(.+)$/) {
                   4836:                 my $item = $1;
                   4837:                 my $type = 'map';
                   4838:                 my $timersymb = $item;
                   4839:                 if ($item eq 'course') {
                   4840:                     $type = 'course';
                   4841:                 } elsif ($item =~ /___\d+___/) {
                   4842:                     $type = 'resource';
                   4843:                 } else {
                   4844:                     $timersymb = &Apache::lonnet::symbread($item);
                   4845:                 }
                   4846:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4847:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4848:                 $triggered{$block} = {
                   4849:                                        start => $start,
                   4850:                                        end   => $end,
                   4851:                                        type  => $type,
                   4852:                                      };
                   4853:             }
                   4854:         }
                   4855:     } else {
                   4856:         foreach my $block (keys(%commblocks)) {
                   4857:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4858:                 my ($start,$end) = ($1,$2);
                   4859:                 if ($start <= time && $end >= time) {
                   4860:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4861:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4862:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4863:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4864:                                     push(@blockers,$block);
                   4865:                                 }
                   4866:                             }
                   4867:                         }
                   4868:                     }
                   4869:                 }
                   4870:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4871:                 my $item = $1;
                   4872:                 my $timersymb = $item; 
                   4873:                 my $type = 'map';
                   4874:                 if ($item eq 'course') {
                   4875:                     $type = 'course';
                   4876:                 } elsif ($item =~ /___\d+___/) {
                   4877:                     $type = 'resource';
                   4878:                 } else {
                   4879:                     $timersymb = &Apache::lonnet::symbread($item);
                   4880:                 }
                   4881:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4882:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4883:                 if ($start && $end) {
                   4884:                     if (($start <= time) && ($end >= time)) {
                   4885:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4886:                             push(@blockers,$block);
                   4887:                             $triggered{$block} = {
                   4888:                                                    start => $start,
                   4889:                                                    end   => $end,
                   4890:                                                    type  => $type,
                   4891:                                                  };
                   4892:                         }
                   4893:                     }
1.490     raeburn  4894:                 }
1.1062    raeburn  4895:             }
                   4896:         }
                   4897:     }
                   4898:     foreach my $blocker (@blockers) {
                   4899:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4900:             &parse_block_record($commblocks{$blocker});
                   4901:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4902:         my ($start,$end,$triggertype);
                   4903:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4904:             ($start,$end) = ($1,$2);
                   4905:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4906:             $start = $triggered{$blocker}{'start'};
                   4907:             $end = $triggered{$blocker}{'end'};
                   4908:             $triggertype = $triggered{$blocker}{'type'};
                   4909:         }
                   4910:         if ($start) {
                   4911:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4912:             if ($triggertype) {
                   4913:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4914:             } else {
                   4915:                 push(@{$$setters{$course}{'triggers'}},0);
                   4916:             }
                   4917:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4918:                 $startblock = $start;
                   4919:                 if ($triggertype) {
                   4920:                     $triggerblock = $blocker;
1.474     raeburn  4921:                 }
                   4922:             }
1.1062    raeburn  4923:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4924:                $endblock = $end;
                   4925:                if ($triggertype) {
                   4926:                    $triggerblock = $blocker;
                   4927:                }
                   4928:             }
1.474     raeburn  4929:         }
                   4930:     }
1.1062    raeburn  4931:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4932: }
                   4933: 
                   4934: sub parse_block_record {
                   4935:     my ($record) = @_;
                   4936:     my ($setuname,$setudom,$title,$blocks);
                   4937:     if (ref($record) eq 'HASH') {
                   4938:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4939:         $title = &unescape($record->{'event'});
                   4940:         $blocks = $record->{'blocks'};
                   4941:     } else {
                   4942:         my @data = split(/:/,$record,3);
                   4943:         if (scalar(@data) eq 2) {
                   4944:             $title = $data[1];
                   4945:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4946:         } else {
                   4947:             ($setuname,$setudom,$title) = @data;
                   4948:         }
                   4949:         $blocks = { 'com' => 'on' };
                   4950:     }
                   4951:     return ($setuname,$setudom,$title,$blocks);
                   4952: }
                   4953: 
1.854     kalberla 4954: sub blocking_status {
1.1189    raeburn  4955:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4956:     my %setters;
1.890     droeschl 4957: 
1.1061    raeburn  4958: # check for active blocking
1.1062    raeburn  4959:     my ($startblock,$endblock,$triggerblock) = 
1.1189    raeburn  4960:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4961:     my $blocked = 0;
                   4962:     if ($startblock && $endblock) {
                   4963:         $blocked = 1;
                   4964:     }
1.890     droeschl 4965: 
1.1061    raeburn  4966: # caller just wants to know whether a block is active
                   4967:     if (!wantarray) { return $blocked; }
                   4968: 
                   4969: # build a link to a popup window containing the details
                   4970:     my $querystring  = "?activity=$activity";
                   4971: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232    raeburn  4972:     if (($activity eq 'port') || ($activity eq 'passwd')) {
                   4973:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
                   4974:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  4975:     } elsif ($activity eq 'docs') {
                   4976:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4977:     }
1.1061    raeburn  4978: 
                   4979:     my $output .= <<'END_MYBLOCK';
                   4980: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4981:     var options = "width=" + w + ",height=" + h + ",";
                   4982:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4983:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4984:     var newWin = window.open(url, wdwName, options);
                   4985:     newWin.focus();
                   4986: }
1.890     droeschl 4987: END_MYBLOCK
1.854     kalberla 4988: 
1.1061    raeburn  4989:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4990:   
1.1061    raeburn  4991:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4992:     my $text = &mt('Communication Blocked');
1.1217    raeburn  4993:     my $class = 'LC_comblock';
1.1062    raeburn  4994:     if ($activity eq 'docs') {
                   4995:         $text = &mt('Content Access Blocked');
1.1217    raeburn  4996:         $class = '';
1.1063    raeburn  4997:     } elsif ($activity eq 'printout') {
                   4998:         $text = &mt('Printing Blocked');
1.1232    raeburn  4999:     } elsif ($activity eq 'passwd') {
                   5000:         $text = &mt('Password Changing Blocked');
1.1062    raeburn  5001:     }
1.1061    raeburn  5002:     $output .= <<"END_BLOCK";
1.1217    raeburn  5003: <div class='$class'>
1.869     kalberla 5004:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5005:   title='$text'>
                   5006:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5007:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5008:   title='$text'>$text</a>
1.867     kalberla 5009: </div>
                   5010: 
                   5011: END_BLOCK
1.474     raeburn  5012: 
1.1061    raeburn  5013:     return ($blocked, $output);
1.854     kalberla 5014: }
1.490     raeburn  5015: 
1.60      matthew  5016: ###############################################
                   5017: 
1.682     raeburn  5018: sub check_ip_acc {
1.1201    raeburn  5019:     my ($acc,$clientip)=@_;
1.682     raeburn  5020:     &Apache::lonxml::debug("acc is $acc");
                   5021:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5022:         return 1;
                   5023:     }
1.1219    raeburn  5024:     my $allowed;
1.1201    raeburn  5025:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682     raeburn  5026: 
                   5027:     my $name;
1.1219    raeburn  5028:     my %access = (
                   5029:                      allowfrom => 1,
                   5030:                      denyfrom  => 0,
                   5031:                  );
                   5032:     my @allows;
                   5033:     my @denies;
                   5034:     foreach my $item (split(',',$acc)) {
                   5035:         $item =~ s/^\s*//;
                   5036:         $item =~ s/\s*$//;
                   5037:         my $pattern;
                   5038:         if ($item =~ /^\!(.+)$/) {
                   5039:             push(@denies,$1);
                   5040:         } else {
                   5041:             push(@allows,$item);
                   5042:         }
                   5043:    }
                   5044:    my $numdenies = scalar(@denies);
                   5045:    my $numallows = scalar(@allows);
                   5046:    my $count = 0;
                   5047:    foreach my $pattern (@denies,@allows) {
                   5048:         $count ++; 
                   5049:         my $acctype = 'allowfrom';
                   5050:         if ($count <= $numdenies) {
                   5051:             $acctype = 'denyfrom';
                   5052:         }
1.682     raeburn  5053:         if ($pattern =~ /\*$/) {
                   5054:             #35.8.*
                   5055:             $pattern=~s/\*//;
1.1219    raeburn  5056:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5057:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5058:             #35.8.3.[34-56]
                   5059:             my $low=$2;
                   5060:             my $high=$3;
                   5061:             $pattern=$1;
                   5062:             if ($ip =~ /^\Q$pattern\E/) {
                   5063:                 my $last=(split(/\./,$ip))[3];
1.1219    raeburn  5064:                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  5065:             }
                   5066:         } elsif ($pattern =~ /^\*/) {
                   5067:             #*.msu.edu
                   5068:             $pattern=~s/\*//;
                   5069:             if (!defined($name)) {
                   5070:                 use Socket;
                   5071:                 my $netaddr=inet_aton($ip);
                   5072:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5073:             }
1.1219    raeburn  5074:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  5075:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5076:             #127.0.0.1
1.1219    raeburn  5077:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5078:         } else {
                   5079:             #some.name.com
                   5080:             if (!defined($name)) {
                   5081:                 use Socket;
                   5082:                 my $netaddr=inet_aton($ip);
                   5083:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5084:             }
1.1219    raeburn  5085:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   5086:         }
                   5087:         if ($allowed =~ /^(0|1)$/) { last; }
                   5088:     }
                   5089:     if ($allowed eq '') {
                   5090:         if ($numdenies && !$numallows) {
                   5091:             $allowed = 1;
                   5092:         } else {
                   5093:             $allowed = 0;
1.682     raeburn  5094:         }
                   5095:     }
                   5096:     return $allowed;
                   5097: }
                   5098: 
                   5099: ###############################################
                   5100: 
1.60      matthew  5101: =pod
                   5102: 
1.112     bowersj2 5103: =head1 Domain Template Functions
                   5104: 
                   5105: =over 4
                   5106: 
                   5107: =item * &determinedomain()
1.60      matthew  5108: 
                   5109: Inputs: $domain (usually will be undef)
                   5110: 
1.63      www      5111: Returns: Determines which domain should be used for designs
1.60      matthew  5112: 
                   5113: =cut
1.54      www      5114: 
1.60      matthew  5115: ###############################################
1.63      www      5116: sub determinedomain {
                   5117:     my $domain=shift;
1.531     albertel 5118:     if (! $domain) {
1.60      matthew  5119:         # Determine domain if we have not been given one
1.893     raeburn  5120:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5121:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5122:         if ($env{'request.role.domain'}) { 
                   5123:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5124:         }
                   5125:     }
1.63      www      5126:     return $domain;
                   5127: }
                   5128: ###############################################
1.517     raeburn  5129: 
1.518     albertel 5130: sub devalidate_domconfig_cache {
                   5131:     my ($udom)=@_;
                   5132:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5133: }
                   5134: 
                   5135: # ---------------------- Get domain configuration for a domain
                   5136: sub get_domainconf {
                   5137:     my ($udom) = @_;
                   5138:     my $cachetime=1800;
                   5139:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5140:     if (defined($cached)) { return %{$result}; }
                   5141: 
                   5142:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5143: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5144:     my (%designhash,%legacy);
1.518     albertel 5145:     if (keys(%domconfig) > 0) {
                   5146:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5147:             if (keys(%{$domconfig{'login'}})) {
                   5148:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5149:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208    raeburn  5150:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5151:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5152:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5153:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5154:                                         if ($key eq 'loginvia') {
                   5155:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5156:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5157:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5158:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5159: 
                   5160:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5161:                                                 } else {
                   5162:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5163:                                                 }
1.948     raeburn  5164:                                             }
1.1208    raeburn  5165:                                         } elsif ($key eq 'headtag') {
                   5166:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5167:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5168:                                             }
1.946     raeburn  5169:                                         }
1.1208    raeburn  5170:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5171:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5172:                                         }
1.946     raeburn  5173:                                     }
                   5174:                                 }
                   5175:                             }
                   5176:                         } else {
                   5177:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5178:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5179:                                     $domconfig{'login'}{$key}{$img};
                   5180:                             }
1.699     raeburn  5181:                         }
                   5182:                     } else {
                   5183:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5184:                     }
1.632     raeburn  5185:                 }
                   5186:             } else {
                   5187:                 $legacy{'login'} = 1;
1.518     albertel 5188:             }
1.632     raeburn  5189:         } else {
                   5190:             $legacy{'login'} = 1;
1.518     albertel 5191:         }
                   5192:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5193:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5194:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5195:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5196:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5197:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5198:                         }
1.518     albertel 5199:                     }
                   5200:                 }
1.632     raeburn  5201:             } else {
                   5202:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5203:             }
1.632     raeburn  5204:         } else {
                   5205:             $legacy{'rolecolors'} = 1;
1.518     albertel 5206:         }
1.948     raeburn  5207:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5208:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5209:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5210:             }
                   5211:         }
1.632     raeburn  5212:         if (keys(%legacy) > 0) {
                   5213:             my %legacyhash = &get_legacy_domconf($udom);
                   5214:             foreach my $item (keys(%legacyhash)) {
                   5215:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5216:                     if ($legacy{'login'}) { 
                   5217:                         $designhash{$item} = $legacyhash{$item};
                   5218:                     }
                   5219:                 } else {
                   5220:                     if ($legacy{'rolecolors'}) {
                   5221:                         $designhash{$item} = $legacyhash{$item};
                   5222:                     }
1.518     albertel 5223:                 }
                   5224:             }
                   5225:         }
1.632     raeburn  5226:     } else {
                   5227:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5228:     }
                   5229:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5230: 				  $cachetime);
                   5231:     return %designhash;
                   5232: }
                   5233: 
1.632     raeburn  5234: sub get_legacy_domconf {
                   5235:     my ($udom) = @_;
                   5236:     my %legacyhash;
                   5237:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5238:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5239:     if (-e $designfile) {
                   5240:         if ( open (my $fh,"<$designfile") ) {
                   5241:             while (my $line = <$fh>) {
                   5242:                 next if ($line =~ /^\#/);
                   5243:                 chomp($line);
                   5244:                 my ($key,$val)=(split(/\=/,$line));
                   5245:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5246:             }
                   5247:             close($fh);
                   5248:         }
                   5249:     }
1.1026    raeburn  5250:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5251:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5252:     }
                   5253:     return %legacyhash;
                   5254: }
                   5255: 
1.63      www      5256: =pod
                   5257: 
1.112     bowersj2 5258: =item * &domainlogo()
1.63      www      5259: 
                   5260: Inputs: $domain (usually will be undef)
                   5261: 
                   5262: Returns: A link to a domain logo, if the domain logo exists.
                   5263: If the domain logo does not exist, a description of the domain.
                   5264: 
                   5265: =cut
1.112     bowersj2 5266: 
1.63      www      5267: ###############################################
                   5268: sub domainlogo {
1.517     raeburn  5269:     my $domain = &determinedomain(shift);
1.518     albertel 5270:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5271:     # See if there is a logo
                   5272:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5273:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5274:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5275: 	    if ($imgsrc =~ m{^/res/}) {
                   5276: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5277: 		&Apache::lonnet::repcopy($local_name);
                   5278: 	    }
                   5279: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  5280:         } 
                   5281:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 5282:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5283:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5284:     } else {
1.60      matthew  5285:         return '';
1.59      www      5286:     }
                   5287: }
1.63      www      5288: ##############################################
                   5289: 
                   5290: =pod
                   5291: 
1.112     bowersj2 5292: =item * &designparm()
1.63      www      5293: 
                   5294: Inputs: $which parameter; $domain (usually will be undef)
                   5295: 
                   5296: Returns: value of designparamter $which
                   5297: 
                   5298: =cut
1.112     bowersj2 5299: 
1.397     albertel 5300: 
1.400     albertel 5301: ##############################################
1.397     albertel 5302: sub designparm {
                   5303:     my ($which,$domain)=@_;
                   5304:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5305:         return $env{'environment.color.'.$which};
1.96      www      5306:     }
1.63      www      5307:     $domain=&determinedomain($domain);
1.1016    raeburn  5308:     my %domdesign;
                   5309:     unless ($domain eq 'public') {
                   5310:         %domdesign = &get_domainconf($domain);
                   5311:     }
1.520     raeburn  5312:     my $output;
1.517     raeburn  5313:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5314:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5315:     } else {
1.520     raeburn  5316:         $output = $defaultdesign{$which};
                   5317:     }
                   5318:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5319:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5320:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5321:             if ($output =~ m{^/res/}) {
                   5322:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5323:                 &Apache::lonnet::repcopy($local_name);
                   5324:             }
1.520     raeburn  5325:             $output = &lonhttpdurl($output);
                   5326:         }
1.63      www      5327:     }
1.520     raeburn  5328:     return $output;
1.63      www      5329: }
1.59      www      5330: 
1.822     bisitz   5331: ##############################################
                   5332: =pod
                   5333: 
1.832     bisitz   5334: =item * &authorspace()
                   5335: 
1.1028    raeburn  5336: Inputs: $url (usually will be undef).
1.832     bisitz   5337: 
1.1132    raeburn  5338: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5339:          directory being viewed (or for which action is being taken). 
                   5340:          If $url is provided, and begins /priv/<domain>/<uname>
                   5341:          the path will be that portion of the $context argument.
                   5342:          Otherwise the path will be for the author space of the current
                   5343:          user when the current role is author, or for that of the 
                   5344:          co-author/assistant co-author space when the current role 
                   5345:          is co-author or assistant co-author.
1.832     bisitz   5346: 
                   5347: =cut
                   5348: 
                   5349: sub authorspace {
1.1028    raeburn  5350:     my ($url) = @_;
                   5351:     if ($url ne '') {
                   5352:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5353:            return $1;
                   5354:         }
                   5355:     }
1.832     bisitz   5356:     my $caname = '';
1.1024    www      5357:     my $cadom = '';
1.1028    raeburn  5358:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5359:         ($cadom,$caname) =
1.832     bisitz   5360:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5361:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5362:         $caname = $env{'user.name'};
1.1024    www      5363:         $cadom = $env{'user.domain'};
1.832     bisitz   5364:     }
1.1028    raeburn  5365:     if (($caname ne '') && ($cadom ne '')) {
                   5366:         return "/priv/$cadom/$caname/";
                   5367:     }
                   5368:     return;
1.832     bisitz   5369: }
                   5370: 
                   5371: ##############################################
                   5372: =pod
                   5373: 
1.822     bisitz   5374: =item * &head_subbox()
                   5375: 
                   5376: Inputs: $content (contains HTML code with page functions, etc.)
                   5377: 
                   5378: Returns: HTML div with $content
                   5379:          To be included in page header
                   5380: 
                   5381: =cut
                   5382: 
                   5383: sub head_subbox {
                   5384:     my ($content)=@_;
                   5385:     my $output =
1.993     raeburn  5386:         '<div class="LC_head_subbox">'
1.822     bisitz   5387:        .$content
                   5388:        .'</div>'
                   5389: }
                   5390: 
                   5391: ##############################################
                   5392: =pod
                   5393: 
                   5394: =item * &CSTR_pageheader()
                   5395: 
1.1026    raeburn  5396: Input: (optional) filename from which breadcrumb trail is built.
                   5397:        In most cases no input as needed, as $env{'request.filename'}
                   5398:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5399: 
                   5400: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5401:          To be included on Authoring Space pages
1.822     bisitz   5402: 
                   5403: =cut
                   5404: 
                   5405: sub CSTR_pageheader {
1.1026    raeburn  5406:     my ($trailfile) = @_;
                   5407:     if ($trailfile eq '') {
                   5408:         $trailfile = $env{'request.filename'};
                   5409:     }
                   5410: 
                   5411: # this is for resources; directories have customtitle, and crumbs
                   5412: # and select recent are created in lonpubdir.pm
                   5413: 
                   5414:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5415:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5416:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5417:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5418:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5419: 
                   5420:     my $parentpath = '';
                   5421:     my $lastitem = '';
                   5422:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5423:         $parentpath = $1;
                   5424:         $lastitem = $2;
                   5425:     } else {
                   5426:         $lastitem = $thisdisfn;
                   5427:     }
1.921     bisitz   5428: 
                   5429:     my $output =
1.822     bisitz   5430:          '<div>'
                   5431:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132    raeburn  5432:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5433:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5434:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5435:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5436: 
                   5437:     if ($lastitem) {
                   5438:         $output .=
                   5439:              '<span class="LC_filename">'
                   5440:             .$lastitem
                   5441:             .'</span>';
                   5442:     }
1.1245  ! raeburn  5443: 
1.921     bisitz   5444:     $output .=
                   5445:          '<br />'
1.822     bisitz   5446:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5447:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5448:         .'</form>'
                   5449:         .&Apache::lonmenu::constspaceform()
                   5450:         .'</div>';
1.921     bisitz   5451: 
                   5452:     return $output;
1.822     bisitz   5453: }
                   5454: 
1.60      matthew  5455: ###############################################
                   5456: ###############################################
                   5457: 
                   5458: =pod
                   5459: 
1.112     bowersj2 5460: =back
                   5461: 
1.549     albertel 5462: =head1 HTML Helpers
1.112     bowersj2 5463: 
                   5464: =over 4
                   5465: 
                   5466: =item * &bodytag()
1.60      matthew  5467: 
                   5468: Returns a uniform header for LON-CAPA web pages.
                   5469: 
                   5470: Inputs: 
                   5471: 
1.112     bowersj2 5472: =over 4
                   5473: 
                   5474: =item * $title, A title to be displayed on the page.
                   5475: 
                   5476: =item * $function, the current role (can be undef).
                   5477: 
                   5478: =item * $addentries, extra parameters for the <body> tag.
                   5479: 
                   5480: =item * $bodyonly, if defined, only return the <body> tag.
                   5481: 
                   5482: =item * $domain, if defined, force a given domain.
                   5483: 
                   5484: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5485:             text interface only)
1.60      matthew  5486: 
1.814     bisitz   5487: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5488:                      navigational links
1.317     albertel 5489: 
1.338     albertel 5490: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5491: 
1.460     albertel 5492: =item * $args, optional argument valid values are
                   5493:             no_auto_mt_title -> prevents &mt()ing the title arg
                   5494: 
1.1096    raeburn  5495: =item * $advtoolsref, optional argument, ref to an array containing
                   5496:             inlineremote items to be added in "Functions" menu below
                   5497:             breadcrumbs.
                   5498: 
1.112     bowersj2 5499: =back
                   5500: 
1.60      matthew  5501: Returns: A uniform header for LON-CAPA web pages.  
                   5502: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5503: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5504: other decorations will be returned.
                   5505: 
                   5506: =cut
                   5507: 
1.54      www      5508: sub bodytag {
1.831     bisitz   5509:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5510:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5511: 
1.954     raeburn  5512:     my $public;
                   5513:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5514:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5515:         $public = 1;
                   5516:     }
1.460     albertel 5517:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  5518:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5519: 
1.183     matthew  5520:     $function = &get_users_function() if (!$function);
1.339     albertel 5521:     my $img =    &designparm($function.'.img',$domain);
                   5522:     my $font =   &designparm($function.'.font',$domain);
                   5523:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5524: 
1.803     bisitz   5525:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5526: 		   'bgcolor' => $pgbg,
1.339     albertel 5527: 		   'text'    => $font,
                   5528:                    'alink'   => &designparm($function.'.alink',$domain),
                   5529: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5530: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5531:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5532: 
1.63      www      5533:  # role and realm
1.1178    raeburn  5534:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5535:     if ($realm) {
                   5536:         $realm = '/'.$realm;
                   5537:     }
1.378     raeburn  5538:     if ($role  eq 'ca') {
1.479     albertel 5539:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5540:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5541:     } 
1.55      www      5542: # realm
1.258     albertel 5543:     if ($env{'request.course.id'}) {
1.378     raeburn  5544:         if ($env{'request.role'} !~ /^cr/) {
                   5545:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5546:         }
1.898     raeburn  5547:         if ($env{'request.course.sec'}) {
                   5548:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5549:         }   
1.359     albertel 5550: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5551:     } else {
                   5552:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5553:     }
1.433     albertel 5554: 
1.359     albertel 5555:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5556: 
1.438     albertel 5557:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5558: 
1.101     www      5559: # construct main body tag
1.359     albertel 5560:     my $bodytag = "<body $extra_body_attr>".
1.1235    raeburn  5561: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 5562: 
1.1131    raeburn  5563:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5564: 
1.1130    raeburn  5565:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5566:         return $bodytag;
1.1130    raeburn  5567:     }
1.359     albertel 5568: 
1.954     raeburn  5569:     if ($public) {
1.433     albertel 5570: 	undef($role);
                   5571:     }
1.359     albertel 5572:     
1.762     bisitz   5573:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5574:     #
                   5575:     # Extra info if you are the DC
                   5576:     my $dc_info = '';
                   5577:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5578:                         $env{'course.'.$env{'request.course.id'}.
                   5579:                                  '.domain'}.'/'})) {
                   5580:         my $cid = $env{'request.course.id'};
1.917     raeburn  5581:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5582:         $dc_info =~ s/\s+$//;
1.359     albertel 5583:     }
                   5584: 
1.1237    raeburn  5585:     my $crstype;
                   5586:     if ($env{'request.course.id'}) {
                   5587:         $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5588:     } elsif ($args->{'crstype'}) {
                   5589:         $crstype = $args->{'crstype'};
                   5590:     }
                   5591:     if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
                   5592:         undef($role);
                   5593:     } else {
1.1242    raeburn  5594:         $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237    raeburn  5595:     }
1.853     droeschl 5596: 
1.903     droeschl 5597:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5598: 
                   5599:         #    if ($env{'request.state'} eq 'construct') {
                   5600:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5601:         #    }
                   5602: 
1.1130    raeburn  5603:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  5604:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5605: 
1.1237    raeburn  5606:         my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359     albertel 5607: 
1.916     droeschl 5608:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5609:              if ($dc_info) {
                   5610:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5611:              }
1.1130    raeburn  5612:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5613:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5614:             return $bodytag;
                   5615:         }
1.894     droeschl 5616: 
1.927     raeburn  5617:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5618:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5619:         }
1.916     droeschl 5620: 
1.1130    raeburn  5621:         $bodytag .= $right;
1.852     droeschl 5622: 
1.917     raeburn  5623:         if ($dc_info) {
                   5624:             $dc_info = &dc_courseid_toggle($dc_info);
                   5625:         }
                   5626:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5627: 
1.1169    raeburn  5628:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  5629:         if ($args->{'no_secondary_menu'}) {
                   5630:             return $bodytag;
                   5631:         }
1.1169    raeburn  5632:         #don't show menus for public users
1.954     raeburn  5633:         if (!$public){
1.1154    raeburn  5634:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5635:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5636:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5637:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5638:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5639:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5640:             } elsif ($forcereg) {
                   5641:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5642:                                                             $args->{'group'});
                   5643:             } else {
                   5644:                 $bodytag .= 
                   5645:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5646:                                                         $forcereg,$args->{'group'},
                   5647:                                                         $args->{'bread_crumbs'},
                   5648:                                                         $advtoolsref);
1.920     raeburn  5649:             }
1.903     droeschl 5650:         }else{
                   5651:             # this is to seperate menu from content when there's no secondary
                   5652:             # menu. Especially needed for public accessible ressources.
                   5653:             $bodytag .= '<hr style="clear:both" />';
                   5654:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5655:         }
1.903     droeschl 5656: 
1.235     raeburn  5657:         return $bodytag;
1.182     matthew  5658: }
                   5659: 
1.917     raeburn  5660: sub dc_courseid_toggle {
                   5661:     my ($dc_info) = @_;
1.980     raeburn  5662:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5663:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5664:            &mt('(More ...)').'</a></span>'.
                   5665:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5666: }
                   5667: 
1.330     albertel 5668: sub make_attr_string {
                   5669:     my ($register,$attr_ref) = @_;
                   5670: 
                   5671:     if ($attr_ref && !ref($attr_ref)) {
                   5672: 	die("addentries Must be a hash ref ".
                   5673: 	    join(':',caller(1))." ".
                   5674: 	    join(':',caller(0))." ");
                   5675:     }
                   5676: 
                   5677:     if ($register) {
1.339     albertel 5678: 	my ($on_load,$on_unload);
                   5679: 	foreach my $key (keys(%{$attr_ref})) {
                   5680: 	    if      (lc($key) eq 'onload') {
                   5681: 		$on_load.=$attr_ref->{$key}.';';
                   5682: 		delete($attr_ref->{$key});
                   5683: 
                   5684: 	    } elsif (lc($key) eq 'onunload') {
                   5685: 		$on_unload.=$attr_ref->{$key}.';';
                   5686: 		delete($attr_ref->{$key});
                   5687: 	    }
                   5688: 	}
1.953     droeschl 5689: 	$attr_ref->{'onload'}  = $on_load;
                   5690: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5691:     }
1.339     albertel 5692: 
1.330     albertel 5693:     my $attr_string;
1.1159    raeburn  5694:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5695: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5696:     }
                   5697:     return $attr_string;
                   5698: }
                   5699: 
                   5700: 
1.182     matthew  5701: ###############################################
1.251     albertel 5702: ###############################################
                   5703: 
                   5704: =pod
                   5705: 
                   5706: =item * &endbodytag()
                   5707: 
                   5708: Returns a uniform footer for LON-CAPA web pages.
                   5709: 
1.635     raeburn  5710: Inputs: 1 - optional reference to an args hash
                   5711: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5712: a 'Continue' link is not displayed if the page contains an
                   5713: internal redirect in the <head></head> section,
                   5714: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5715: 
                   5716: =cut
                   5717: 
                   5718: sub endbodytag {
1.635     raeburn  5719:     my ($args) = @_;
1.1080    raeburn  5720:     my $endbodytag;
                   5721:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5722:         $endbodytag='</body>';
                   5723:     }
1.315     albertel 5724:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5725:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5726: 	    $endbodytag=
                   5727: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5728: 	        &mt('Continue').'</a>'.
                   5729: 	        $endbodytag;
                   5730:         }
1.315     albertel 5731:     }
1.251     albertel 5732:     return $endbodytag;
                   5733: }
                   5734: 
1.352     albertel 5735: =pod
                   5736: 
                   5737: =item * &standard_css()
                   5738: 
                   5739: Returns a style sheet
                   5740: 
                   5741: Inputs: (all optional)
                   5742:             domain         -> force to color decorate a page for a specific
                   5743:                                domain
                   5744:             function       -> force usage of a specific rolish color scheme
                   5745:             bgcolor        -> override the default page bgcolor
                   5746: 
                   5747: =cut
                   5748: 
1.343     albertel 5749: sub standard_css {
1.345     albertel 5750:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5751:     $function  = &get_users_function() if (!$function);
                   5752:     my $img    = &designparm($function.'.img',   $domain);
                   5753:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5754:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5755:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5756: #second colour for later usage
1.345     albertel 5757:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5758:     my $pgbg_or_bgcolor =
                   5759: 	         $bgcolor ||
1.352     albertel 5760: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5761:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5762:     my $alink  = &designparm($function.'.alink', $domain);
                   5763:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5764:     my $link   = &designparm($function.'.link',  $domain);
                   5765: 
1.602     albertel 5766:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5767:     my $mono                 = 'monospace';
1.850     bisitz   5768:     my $data_table_head      = $sidebg;
                   5769:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5770:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5771:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5772:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5773:     my $mail_new             = '#FFBB77';
                   5774:     my $mail_new_hover       = '#DD9955';
                   5775:     my $mail_read            = '#BBBB77';
                   5776:     my $mail_read_hover      = '#999944';
                   5777:     my $mail_replied         = '#AAAA88';
                   5778:     my $mail_replied_hover   = '#888855';
                   5779:     my $mail_other           = '#99BBBB';
                   5780:     my $mail_other_hover     = '#669999';
1.391     albertel 5781:     my $table_header         = '#DDDDDD';
1.489     raeburn  5782:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5783:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5784:     my $button_hover         = '#BF2317';
1.392     albertel 5785: 
1.608     albertel 5786:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5787:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5788:                                              : '0 3px 0 4px';
1.448     albertel 5789: 
1.523     albertel 5790: 
1.343     albertel 5791:     return <<END;
1.947     droeschl 5792: 
                   5793: /* needed for iframe to allow 100% height in FF */
                   5794: body, html { 
                   5795:     margin: 0;
                   5796:     padding: 0 0.5%;
                   5797:     height: 99%; /* to avoid scrollbars */
                   5798: }
                   5799: 
1.795     www      5800: body {
1.911     bisitz   5801:   font-family: $sans;
                   5802:   line-height:130%;
                   5803:   font-size:0.83em;
                   5804:   color:$font;
1.795     www      5805: }
                   5806: 
1.959     onken    5807: a:focus,
                   5808: a:focus img {
1.795     www      5809:   color: red;
                   5810: }
1.698     harmsja  5811: 
1.911     bisitz   5812: form, .inline {
                   5813:   display: inline;
1.795     www      5814: }
1.721     harmsja  5815: 
1.795     www      5816: .LC_right {
1.911     bisitz   5817:   text-align:right;
1.795     www      5818: }
                   5819: 
                   5820: .LC_middle {
1.911     bisitz   5821:   vertical-align:middle;
1.795     www      5822: }
1.721     harmsja  5823: 
1.1130    raeburn  5824: .LC_floatleft {
                   5825:   float: left;
                   5826: }
                   5827: 
                   5828: .LC_floatright {
                   5829:   float: right;
                   5830: }
                   5831: 
1.911     bisitz   5832: .LC_400Box {
                   5833:   width:400px;
                   5834: }
1.721     harmsja  5835: 
1.947     droeschl 5836: .LC_iframecontainer {
                   5837:     width: 98%;
                   5838:     margin: 0;
                   5839:     position: fixed;
                   5840:     top: 8.5em;
                   5841:     bottom: 0;
                   5842: }
                   5843: 
                   5844: .LC_iframecontainer iframe{
                   5845:     border: none;
                   5846:     width: 100%;
                   5847:     height: 100%;
                   5848: }
                   5849: 
1.778     bisitz   5850: .LC_filename {
                   5851:   font-family: $mono;
                   5852:   white-space:pre;
1.921     bisitz   5853:   font-size: 120%;
1.778     bisitz   5854: }
                   5855: 
                   5856: .LC_fileicon {
                   5857:   border: none;
                   5858:   height: 1.3em;
                   5859:   vertical-align: text-bottom;
                   5860:   margin-right: 0.3em;
                   5861:   text-decoration:none;
                   5862: }
                   5863: 
1.1008    www      5864: .LC_setting {
                   5865:   text-decoration:underline;
                   5866: }
                   5867: 
1.350     albertel 5868: .LC_error {
                   5869:   color: red;
                   5870: }
1.795     www      5871: 
1.1097    bisitz   5872: .LC_warning {
                   5873:   color: darkorange;
                   5874: }
                   5875: 
1.457     albertel 5876: .LC_diff_removed {
1.733     bisitz   5877:   color: red;
1.394     albertel 5878: }
1.532     albertel 5879: 
                   5880: .LC_info,
1.457     albertel 5881: .LC_success,
                   5882: .LC_diff_added {
1.350     albertel 5883:   color: green;
                   5884: }
1.795     www      5885: 
1.802     bisitz   5886: div.LC_confirm_box {
                   5887:   background-color: #FAFAFA;
                   5888:   border: 1px solid $lg_border_color;
                   5889:   margin-right: 0;
                   5890:   padding: 5px;
                   5891: }
                   5892: 
                   5893: div.LC_confirm_box .LC_error img,
                   5894: div.LC_confirm_box .LC_success img {
                   5895:   vertical-align: middle;
                   5896: }
                   5897: 
1.1242    raeburn  5898: .LC_maxwidth {
                   5899:   max-width: 100%;
                   5900:   height: auto;
                   5901: }
                   5902: 
1.1243    raeburn  5903: .LC_textsize_mobile {
                   5904:   \@media only screen and (max-device-width: 480px) {
                   5905:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   5906:   }
                   5907: }
                   5908: 
1.440     albertel 5909: .LC_icon {
1.771     droeschl 5910:   border: none;
1.790     droeschl 5911:   vertical-align: middle;
1.771     droeschl 5912: }
                   5913: 
1.543     albertel 5914: .LC_docs_spacer {
                   5915:   width: 25px;
                   5916:   height: 1px;
1.771     droeschl 5917:   border: none;
1.543     albertel 5918: }
1.346     albertel 5919: 
1.532     albertel 5920: .LC_internal_info {
1.735     bisitz   5921:   color: #999999;
1.532     albertel 5922: }
                   5923: 
1.794     www      5924: .LC_discussion {
1.1050    www      5925:   background: $data_table_dark;
1.911     bisitz   5926:   border: 1px solid black;
                   5927:   margin: 2px;
1.794     www      5928: }
                   5929: 
                   5930: .LC_disc_action_left {
1.1050    www      5931:   background: $sidebg;
1.911     bisitz   5932:   text-align: left;
1.1050    www      5933:   padding: 4px;
                   5934:   margin: 2px;
1.794     www      5935: }
                   5936: 
                   5937: .LC_disc_action_right {
1.1050    www      5938:   background: $sidebg;
1.911     bisitz   5939:   text-align: right;
1.1050    www      5940:   padding: 4px;
                   5941:   margin: 2px;
1.794     www      5942: }
                   5943: 
                   5944: .LC_disc_new_item {
1.911     bisitz   5945:   background: white;
                   5946:   border: 2px solid red;
1.1050    www      5947:   margin: 4px;
                   5948:   padding: 4px;
1.794     www      5949: }
                   5950: 
                   5951: .LC_disc_old_item {
1.911     bisitz   5952:   background: white;
1.1050    www      5953:   margin: 4px;
                   5954:   padding: 4px;
1.794     www      5955: }
                   5956: 
1.458     albertel 5957: table.LC_pastsubmission {
                   5958:   border: 1px solid black;
                   5959:   margin: 2px;
                   5960: }
                   5961: 
1.924     bisitz   5962: table#LC_menubuttons {
1.345     albertel 5963:   width: 100%;
                   5964:   background: $pgbg;
1.392     albertel 5965:   border: 2px;
1.402     albertel 5966:   border-collapse: separate;
1.803     bisitz   5967:   padding: 0;
1.345     albertel 5968: }
1.392     albertel 5969: 
1.801     tempelho 5970: table#LC_title_bar a {
                   5971:   color: $fontmenu;
                   5972: }
1.836     bisitz   5973: 
1.807     droeschl 5974: table#LC_title_bar {
1.819     tempelho 5975:   clear: both;
1.836     bisitz   5976:   display: none;
1.807     droeschl 5977: }
                   5978: 
1.795     www      5979: table#LC_title_bar,
1.933     droeschl 5980: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5981: table#LC_title_bar.LC_with_remote {
1.359     albertel 5982:   width: 100%;
1.392     albertel 5983:   border-color: $pgbg;
                   5984:   border-style: solid;
                   5985:   border-width: $border;
1.379     albertel 5986:   background: $pgbg;
1.801     tempelho 5987:   color: $fontmenu;
1.392     albertel 5988:   border-collapse: collapse;
1.803     bisitz   5989:   padding: 0;
1.819     tempelho 5990:   margin: 0;
1.359     albertel 5991: }
1.795     www      5992: 
1.933     droeschl 5993: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5994:     margin: 0;
                   5995:     padding: 0;
1.933     droeschl 5996:     position: relative;
                   5997:     list-style: none;
1.913     droeschl 5998: }
1.933     droeschl 5999: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 6000:     display: inline;
                   6001: }
1.933     droeschl 6002: 
                   6003: .LC_breadcrumb_tools_navigation {
1.913     droeschl 6004:     padding: 0;
1.933     droeschl 6005:     margin: 0;
                   6006:     float: left;
1.913     droeschl 6007: }
1.933     droeschl 6008: .LC_breadcrumb_tools_tools {
                   6009:     padding: 0;
                   6010:     margin: 0;
1.913     droeschl 6011:     float: right;
                   6012: }
                   6013: 
1.1240    raeburn  6014: .LC_placement_prog {
                   6015:     padding-right: 20px;
                   6016:     font-weight: bold;
                   6017:     font-size: 90%;
                   6018: }
                   6019: 
1.359     albertel 6020: table#LC_title_bar td {
                   6021:   background: $tabbg;
                   6022: }
1.795     www      6023: 
1.911     bisitz   6024: table#LC_menubuttons img {
1.803     bisitz   6025:   border: none;
1.346     albertel 6026: }
1.795     www      6027: 
1.842     droeschl 6028: .LC_breadcrumbs_component {
1.911     bisitz   6029:   float: right;
                   6030:   margin: 0 1em;
1.357     albertel 6031: }
1.842     droeschl 6032: .LC_breadcrumbs_component img {
1.911     bisitz   6033:   vertical-align: middle;
1.777     tempelho 6034: }
1.795     www      6035: 
1.1243    raeburn  6036: .LC_breadcrumbs_hoverable {
                   6037:   background: $sidebg;
                   6038: }
                   6039: 
1.383     albertel 6040: td.LC_table_cell_checkbox {
                   6041:   text-align: center;
                   6042: }
1.795     www      6043: 
                   6044: .LC_fontsize_small {
1.911     bisitz   6045:   font-size: 70%;
1.705     tempelho 6046: }
                   6047: 
1.844     bisitz   6048: #LC_breadcrumbs {
1.911     bisitz   6049:   clear:both;
                   6050:   background: $sidebg;
                   6051:   border-bottom: 1px solid $lg_border_color;
                   6052:   line-height: 2.5em;
1.933     droeschl 6053:   overflow: hidden;
1.911     bisitz   6054:   margin: 0;
                   6055:   padding: 0;
1.995     raeburn  6056:   text-align: left;
1.819     tempelho 6057: }
1.862     bisitz   6058: 
1.1098    bisitz   6059: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6060:   clear:both;
                   6061:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6062:   border: 1px solid $sidebg;
1.1098    bisitz   6063:   margin: 0 0 10px 0;
1.966     bisitz   6064:   padding: 3px;
1.995     raeburn  6065:   text-align: left;
1.822     bisitz   6066: }
                   6067: 
1.795     www      6068: .LC_fontsize_medium {
1.911     bisitz   6069:   font-size: 85%;
1.705     tempelho 6070: }
                   6071: 
1.795     www      6072: .LC_fontsize_large {
1.911     bisitz   6073:   font-size: 120%;
1.705     tempelho 6074: }
                   6075: 
1.346     albertel 6076: .LC_menubuttons_inline_text {
                   6077:   color: $font;
1.698     harmsja  6078:   font-size: 90%;
1.701     harmsja  6079:   padding-left:3px;
1.346     albertel 6080: }
                   6081: 
1.934     droeschl 6082: .LC_menubuttons_inline_text img{
                   6083:   vertical-align: middle;
                   6084: }
                   6085: 
1.1051    www      6086: li.LC_menubuttons_inline_text img {
1.951     onken    6087:   cursor:pointer;
1.1002    droeschl 6088:   text-decoration: none;
1.951     onken    6089: }
                   6090: 
1.526     www      6091: .LC_menubuttons_link {
                   6092:   text-decoration: none;
                   6093: }
1.795     www      6094: 
1.522     albertel 6095: .LC_menubuttons_category {
1.521     www      6096:   color: $font;
1.526     www      6097:   background: $pgbg;
1.521     www      6098:   font-size: larger;
                   6099:   font-weight: bold;
                   6100: }
                   6101: 
1.346     albertel 6102: td.LC_menubuttons_text {
1.911     bisitz   6103:   color: $font;
1.346     albertel 6104: }
1.706     harmsja  6105: 
1.346     albertel 6106: .LC_current_location {
                   6107:   background: $tabbg;
                   6108: }
1.795     www      6109: 
1.938     bisitz   6110: table.LC_data_table {
1.347     albertel 6111:   border: 1px solid #000000;
1.402     albertel 6112:   border-collapse: separate;
1.426     albertel 6113:   border-spacing: 1px;
1.610     albertel 6114:   background: $pgbg;
1.347     albertel 6115: }
1.795     www      6116: 
1.422     albertel 6117: .LC_data_table_dense {
                   6118:   font-size: small;
                   6119: }
1.795     www      6120: 
1.507     raeburn  6121: table.LC_nested_outer {
                   6122:   border: 1px solid #000000;
1.589     raeburn  6123:   border-collapse: collapse;
1.803     bisitz   6124:   border-spacing: 0;
1.507     raeburn  6125:   width: 100%;
                   6126: }
1.795     www      6127: 
1.879     raeburn  6128: table.LC_innerpickbox,
1.507     raeburn  6129: table.LC_nested {
1.803     bisitz   6130:   border: none;
1.589     raeburn  6131:   border-collapse: collapse;
1.803     bisitz   6132:   border-spacing: 0;
1.507     raeburn  6133:   width: 100%;
                   6134: }
1.795     www      6135: 
1.911     bisitz   6136: table.LC_data_table tr th,
                   6137: table.LC_calendar tr th,
1.879     raeburn  6138: table.LC_prior_tries tr th,
                   6139: table.LC_innerpickbox tr th {
1.349     albertel 6140:   font-weight: bold;
                   6141:   background-color: $data_table_head;
1.801     tempelho 6142:   color:$fontmenu;
1.701     harmsja  6143:   font-size:90%;
1.347     albertel 6144: }
1.795     www      6145: 
1.879     raeburn  6146: table.LC_innerpickbox tr th,
                   6147: table.LC_innerpickbox tr td {
                   6148:   vertical-align: top;
                   6149: }
                   6150: 
1.711     raeburn  6151: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   6152:   background-color: #CCCCCC;
1.711     raeburn  6153:   font-weight: bold;
                   6154:   text-align: left;
                   6155: }
1.795     www      6156: 
1.912     bisitz   6157: table.LC_data_table tr.LC_odd_row > td {
                   6158:   background-color: $data_table_light;
                   6159:   padding: 2px;
                   6160:   vertical-align: top;
                   6161: }
                   6162: 
1.809     bisitz   6163: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 6164:   background-color: $data_table_light;
1.912     bisitz   6165:   vertical-align: top;
                   6166: }
                   6167: 
                   6168: table.LC_data_table tr.LC_even_row > td {
                   6169:   background-color: $data_table_dark;
1.425     albertel 6170:   padding: 2px;
1.900     bisitz   6171:   vertical-align: top;
1.347     albertel 6172: }
1.795     www      6173: 
1.809     bisitz   6174: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 6175:   background-color: $data_table_dark;
1.900     bisitz   6176:   vertical-align: top;
1.347     albertel 6177: }
1.795     www      6178: 
1.425     albertel 6179: table.LC_data_table tr.LC_data_table_highlight td {
                   6180:   background-color: $data_table_darker;
                   6181: }
1.795     www      6182: 
1.639     raeburn  6183: table.LC_data_table tr td.LC_leftcol_header {
                   6184:   background-color: $data_table_head;
                   6185:   font-weight: bold;
                   6186: }
1.795     www      6187: 
1.451     albertel 6188: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  6189: table.LC_nested tr.LC_empty_row td {
1.421     albertel 6190:   font-weight: bold;
                   6191:   font-style: italic;
                   6192:   text-align: center;
                   6193:   padding: 8px;
1.347     albertel 6194: }
1.795     www      6195: 
1.1114    raeburn  6196: table.LC_data_table tr.LC_empty_row td,
                   6197: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   6198:   background-color: $sidebg;
                   6199: }
                   6200: 
                   6201: table.LC_nested tr.LC_empty_row td {
                   6202:   background-color: #FFFFFF;
                   6203: }
                   6204: 
1.890     droeschl 6205: table.LC_caption {
                   6206: }
                   6207: 
1.507     raeburn  6208: table.LC_nested tr.LC_empty_row td {
1.465     albertel 6209:   padding: 4ex
                   6210: }
1.795     www      6211: 
1.507     raeburn  6212: table.LC_nested_outer tr th {
                   6213:   font-weight: bold;
1.801     tempelho 6214:   color:$fontmenu;
1.507     raeburn  6215:   background-color: $data_table_head;
1.701     harmsja  6216:   font-size: small;
1.507     raeburn  6217:   border-bottom: 1px solid #000000;
                   6218: }
1.795     www      6219: 
1.507     raeburn  6220: table.LC_nested_outer tr td.LC_subheader {
                   6221:   background-color: $data_table_head;
                   6222:   font-weight: bold;
                   6223:   font-size: small;
                   6224:   border-bottom: 1px solid #000000;
                   6225:   text-align: right;
1.451     albertel 6226: }
1.795     www      6227: 
1.507     raeburn  6228: table.LC_nested tr.LC_info_row td {
1.735     bisitz   6229:   background-color: #CCCCCC;
1.451     albertel 6230:   font-weight: bold;
                   6231:   font-size: small;
1.507     raeburn  6232:   text-align: center;
                   6233: }
1.795     www      6234: 
1.589     raeburn  6235: table.LC_nested tr.LC_info_row td.LC_left_item,
                   6236: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  6237:   text-align: left;
1.451     albertel 6238: }
1.795     www      6239: 
1.507     raeburn  6240: table.LC_nested td {
1.735     bisitz   6241:   background-color: #FFFFFF;
1.451     albertel 6242:   font-size: small;
1.507     raeburn  6243: }
1.795     www      6244: 
1.507     raeburn  6245: table.LC_nested_outer tr th.LC_right_item,
                   6246: table.LC_nested tr.LC_info_row td.LC_right_item,
                   6247: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   6248: table.LC_nested tr td.LC_right_item {
1.451     albertel 6249:   text-align: right;
                   6250: }
                   6251: 
1.507     raeburn  6252: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   6253:   background-color: #EEEEEE;
1.451     albertel 6254: }
                   6255: 
1.473     raeburn  6256: table.LC_createuser {
                   6257: }
                   6258: 
                   6259: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  6260:   font-size: small;
1.473     raeburn  6261: }
                   6262: 
                   6263: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   6264:   background-color: #CCCCCC;
1.473     raeburn  6265:   font-weight: bold;
                   6266:   text-align: center;
                   6267: }
                   6268: 
1.349     albertel 6269: table.LC_calendar {
                   6270:   border: 1px solid #000000;
                   6271:   border-collapse: collapse;
1.917     raeburn  6272:   width: 98%;
1.349     albertel 6273: }
1.795     www      6274: 
1.349     albertel 6275: table.LC_calendar_pickdate {
                   6276:   font-size: xx-small;
                   6277: }
1.795     www      6278: 
1.349     albertel 6279: table.LC_calendar tr td {
                   6280:   border: 1px solid #000000;
                   6281:   vertical-align: top;
1.917     raeburn  6282:   width: 14%;
1.349     albertel 6283: }
1.795     www      6284: 
1.349     albertel 6285: table.LC_calendar tr td.LC_calendar_day_empty {
                   6286:   background-color: $data_table_dark;
                   6287: }
1.795     www      6288: 
1.779     bisitz   6289: table.LC_calendar tr td.LC_calendar_day_current {
                   6290:   background-color: $data_table_highlight;
1.777     tempelho 6291: }
1.795     www      6292: 
1.938     bisitz   6293: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 6294:   background-color: $mail_new;
                   6295: }
1.795     www      6296: 
1.938     bisitz   6297: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 6298:   background-color: $mail_new_hover;
                   6299: }
1.795     www      6300: 
1.938     bisitz   6301: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 6302:   background-color: $mail_read;
                   6303: }
1.795     www      6304: 
1.938     bisitz   6305: /*
                   6306: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 6307:   background-color: $mail_read_hover;
                   6308: }
1.938     bisitz   6309: */
1.795     www      6310: 
1.938     bisitz   6311: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 6312:   background-color: $mail_replied;
                   6313: }
1.795     www      6314: 
1.938     bisitz   6315: /*
                   6316: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 6317:   background-color: $mail_replied_hover;
                   6318: }
1.938     bisitz   6319: */
1.795     www      6320: 
1.938     bisitz   6321: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6322:   background-color: $mail_other;
                   6323: }
1.795     www      6324: 
1.938     bisitz   6325: /*
                   6326: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6327:   background-color: $mail_other_hover;
                   6328: }
1.938     bisitz   6329: */
1.494     raeburn  6330: 
1.777     tempelho 6331: table.LC_data_table tr > td.LC_browser_file,
                   6332: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6333:   background: #AAEE77;
1.389     albertel 6334: }
1.795     www      6335: 
1.777     tempelho 6336: table.LC_data_table tr > td.LC_browser_file_locked,
                   6337: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6338:   background: #FFAA99;
1.387     albertel 6339: }
1.795     www      6340: 
1.777     tempelho 6341: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6342:   background: #888888;
1.779     bisitz   6343: }
1.795     www      6344: 
1.777     tempelho 6345: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6346: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6347:   background: #F8F866;
1.777     tempelho 6348: }
1.795     www      6349: 
1.696     bisitz   6350: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6351:   background: #E0E8FF;
1.387     albertel 6352: }
1.696     bisitz   6353: 
1.707     bisitz   6354: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6355:   /* background: #77FF77; */
1.707     bisitz   6356: }
1.795     www      6357: 
1.707     bisitz   6358: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6359:   border-right: 8px solid #FFFF77;
1.707     bisitz   6360: }
1.795     www      6361: 
1.707     bisitz   6362: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6363:   border-right: 8px solid #FFAA77;
1.707     bisitz   6364: }
1.795     www      6365: 
1.707     bisitz   6366: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6367:   border-right: 8px solid #FF7777;
1.707     bisitz   6368: }
1.795     www      6369: 
1.707     bisitz   6370: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6371:   border-right: 8px solid #AAFF77;
1.707     bisitz   6372: }
1.795     www      6373: 
1.707     bisitz   6374: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6375:   border-right: 8px solid #11CC55;
1.707     bisitz   6376: }
                   6377: 
1.388     albertel 6378: span.LC_current_location {
1.701     harmsja  6379:   font-size:larger;
1.388     albertel 6380:   background: $pgbg;
                   6381: }
1.387     albertel 6382: 
1.1029    www      6383: span.LC_current_nav_location {
                   6384:   font-weight:bold;
                   6385:   background: $sidebg;
                   6386: }
                   6387: 
1.395     albertel 6388: span.LC_parm_menu_item {
                   6389:   font-size: larger;
                   6390: }
1.795     www      6391: 
1.395     albertel 6392: span.LC_parm_scope_all {
                   6393:   color: red;
                   6394: }
1.795     www      6395: 
1.395     albertel 6396: span.LC_parm_scope_folder {
                   6397:   color: green;
                   6398: }
1.795     www      6399: 
1.395     albertel 6400: span.LC_parm_scope_resource {
                   6401:   color: orange;
                   6402: }
1.795     www      6403: 
1.395     albertel 6404: span.LC_parm_part {
                   6405:   color: blue;
                   6406: }
1.795     www      6407: 
1.911     bisitz   6408: span.LC_parm_folder,
                   6409: span.LC_parm_symb {
1.395     albertel 6410:   font-size: x-small;
                   6411:   font-family: $mono;
                   6412:   color: #AAAAAA;
                   6413: }
                   6414: 
1.977     bisitz   6415: ul.LC_parm_parmlist li {
                   6416:   display: inline-block;
                   6417:   padding: 0.3em 0.8em;
                   6418:   vertical-align: top;
                   6419:   width: 150px;
                   6420:   border-top:1px solid $lg_border_color;
                   6421: }
                   6422: 
1.795     www      6423: td.LC_parm_overview_level_menu,
                   6424: td.LC_parm_overview_map_menu,
                   6425: td.LC_parm_overview_parm_selectors,
                   6426: td.LC_parm_overview_restrictions  {
1.396     albertel 6427:   border: 1px solid black;
                   6428:   border-collapse: collapse;
                   6429: }
1.795     www      6430: 
1.396     albertel 6431: table.LC_parm_overview_restrictions td {
                   6432:   border-width: 1px 4px 1px 4px;
                   6433:   border-style: solid;
                   6434:   border-color: $pgbg;
                   6435:   text-align: center;
                   6436: }
1.795     www      6437: 
1.396     albertel 6438: table.LC_parm_overview_restrictions th {
                   6439:   background: $tabbg;
                   6440:   border-width: 1px 4px 1px 4px;
                   6441:   border-style: solid;
                   6442:   border-color: $pgbg;
                   6443: }
1.795     www      6444: 
1.398     albertel 6445: table#LC_helpmenu {
1.803     bisitz   6446:   border: none;
1.398     albertel 6447:   height: 55px;
1.803     bisitz   6448:   border-spacing: 0;
1.398     albertel 6449: }
                   6450: 
                   6451: table#LC_helpmenu fieldset legend {
                   6452:   font-size: larger;
                   6453: }
1.795     www      6454: 
1.397     albertel 6455: table#LC_helpmenu_links {
                   6456:   width: 100%;
                   6457:   border: 1px solid black;
                   6458:   background: $pgbg;
1.803     bisitz   6459:   padding: 0;
1.397     albertel 6460:   border-spacing: 1px;
                   6461: }
1.795     www      6462: 
1.397     albertel 6463: table#LC_helpmenu_links tr td {
                   6464:   padding: 1px;
                   6465:   background: $tabbg;
1.399     albertel 6466:   text-align: center;
                   6467:   font-weight: bold;
1.397     albertel 6468: }
1.396     albertel 6469: 
1.795     www      6470: table#LC_helpmenu_links a:link,
                   6471: table#LC_helpmenu_links a:visited,
1.397     albertel 6472: table#LC_helpmenu_links a:active {
                   6473:   text-decoration: none;
                   6474:   color: $font;
                   6475: }
1.795     www      6476: 
1.397     albertel 6477: table#LC_helpmenu_links a:hover {
                   6478:   text-decoration: underline;
                   6479:   color: $vlink;
                   6480: }
1.396     albertel 6481: 
1.417     albertel 6482: .LC_chrt_popup_exists {
                   6483:   border: 1px solid #339933;
                   6484:   margin: -1px;
                   6485: }
1.795     www      6486: 
1.417     albertel 6487: .LC_chrt_popup_up {
                   6488:   border: 1px solid yellow;
                   6489:   margin: -1px;
                   6490: }
1.795     www      6491: 
1.417     albertel 6492: .LC_chrt_popup {
                   6493:   border: 1px solid #8888FF;
                   6494:   background: #CCCCFF;
                   6495: }
1.795     www      6496: 
1.421     albertel 6497: table.LC_pick_box {
                   6498:   border-collapse: separate;
                   6499:   background: white;
                   6500:   border: 1px solid black;
                   6501:   border-spacing: 1px;
                   6502: }
1.795     www      6503: 
1.421     albertel 6504: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6505:   background: $sidebg;
1.421     albertel 6506:   font-weight: bold;
1.900     bisitz   6507:   text-align: left;
1.740     bisitz   6508:   vertical-align: top;
1.421     albertel 6509:   width: 184px;
                   6510:   padding: 8px;
                   6511: }
1.795     www      6512: 
1.579     raeburn  6513: table.LC_pick_box td.LC_pick_box_value {
                   6514:   text-align: left;
                   6515:   padding: 8px;
                   6516: }
1.795     www      6517: 
1.579     raeburn  6518: table.LC_pick_box td.LC_pick_box_select {
                   6519:   text-align: left;
                   6520:   padding: 8px;
                   6521: }
1.795     www      6522: 
1.424     albertel 6523: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6524:   padding: 0;
1.421     albertel 6525:   height: 1px;
                   6526:   background: black;
                   6527: }
1.795     www      6528: 
1.421     albertel 6529: table.LC_pick_box td.LC_pick_box_submit {
                   6530:   text-align: right;
                   6531: }
1.795     www      6532: 
1.579     raeburn  6533: table.LC_pick_box td.LC_evenrow_value {
                   6534:   text-align: left;
                   6535:   padding: 8px;
                   6536:   background-color: $data_table_light;
                   6537: }
1.795     www      6538: 
1.579     raeburn  6539: table.LC_pick_box td.LC_oddrow_value {
                   6540:   text-align: left;
                   6541:   padding: 8px;
                   6542:   background-color: $data_table_light;
                   6543: }
1.795     www      6544: 
1.579     raeburn  6545: span.LC_helpform_receipt_cat {
                   6546:   font-weight: bold;
                   6547: }
1.795     www      6548: 
1.424     albertel 6549: table.LC_group_priv_box {
                   6550:   background: white;
                   6551:   border: 1px solid black;
                   6552:   border-spacing: 1px;
                   6553: }
1.795     www      6554: 
1.424     albertel 6555: table.LC_group_priv_box td.LC_pick_box_title {
                   6556:   background: $tabbg;
                   6557:   font-weight: bold;
                   6558:   text-align: right;
                   6559:   width: 184px;
                   6560: }
1.795     www      6561: 
1.424     albertel 6562: table.LC_group_priv_box td.LC_groups_fixed {
                   6563:   background: $data_table_light;
                   6564:   text-align: center;
                   6565: }
1.795     www      6566: 
1.424     albertel 6567: table.LC_group_priv_box td.LC_groups_optional {
                   6568:   background: $data_table_dark;
                   6569:   text-align: center;
                   6570: }
1.795     www      6571: 
1.424     albertel 6572: table.LC_group_priv_box td.LC_groups_functionality {
                   6573:   background: $data_table_darker;
                   6574:   text-align: center;
                   6575:   font-weight: bold;
                   6576: }
1.795     www      6577: 
1.424     albertel 6578: table.LC_group_priv td {
                   6579:   text-align: left;
1.803     bisitz   6580:   padding: 0;
1.424     albertel 6581: }
                   6582: 
                   6583: .LC_navbuttons {
                   6584:   margin: 2ex 0ex 2ex 0ex;
                   6585: }
1.795     www      6586: 
1.423     albertel 6587: .LC_topic_bar {
                   6588:   font-weight: bold;
                   6589:   background: $tabbg;
1.918     wenzelju 6590:   margin: 1em 0em 1em 2em;
1.805     bisitz   6591:   padding: 3px;
1.918     wenzelju 6592:   font-size: 1.2em;
1.423     albertel 6593: }
1.795     www      6594: 
1.423     albertel 6595: .LC_topic_bar span {
1.918     wenzelju 6596:   left: 0.5em;
                   6597:   position: absolute;
1.423     albertel 6598:   vertical-align: middle;
1.918     wenzelju 6599:   font-size: 1.2em;
1.423     albertel 6600: }
1.795     www      6601: 
1.423     albertel 6602: table.LC_course_group_status {
                   6603:   margin: 20px;
                   6604: }
1.795     www      6605: 
1.423     albertel 6606: table.LC_status_selector td {
                   6607:   vertical-align: top;
                   6608:   text-align: center;
1.424     albertel 6609:   padding: 4px;
                   6610: }
1.795     www      6611: 
1.599     albertel 6612: div.LC_feedback_link {
1.616     albertel 6613:   clear: both;
1.829     kalberla 6614:   background: $sidebg;
1.779     bisitz   6615:   width: 100%;
1.829     kalberla 6616:   padding-bottom: 10px;
                   6617:   border: 1px $tabbg solid;
1.833     kalberla 6618:   height: 22px;
                   6619:   line-height: 22px;
                   6620:   padding-top: 5px;
                   6621: }
                   6622: 
                   6623: div.LC_feedback_link img {
                   6624:   height: 22px;
1.867     kalberla 6625:   vertical-align:middle;
1.829     kalberla 6626: }
                   6627: 
1.911     bisitz   6628: div.LC_feedback_link a {
1.829     kalberla 6629:   text-decoration: none;
1.489     raeburn  6630: }
1.795     www      6631: 
1.867     kalberla 6632: div.LC_comblock {
1.911     bisitz   6633:   display:inline;
1.867     kalberla 6634:   color:$font;
                   6635:   font-size:90%;
                   6636: }
                   6637: 
                   6638: div.LC_feedback_link div.LC_comblock {
                   6639:   padding-left:5px;
                   6640: }
                   6641: 
                   6642: div.LC_feedback_link div.LC_comblock a {
                   6643:   color:$font;
                   6644: }
                   6645: 
1.489     raeburn  6646: span.LC_feedback_link {
1.858     bisitz   6647:   /* background: $feedback_link_bg; */
1.599     albertel 6648:   font-size: larger;
                   6649: }
1.795     www      6650: 
1.599     albertel 6651: span.LC_message_link {
1.858     bisitz   6652:   /* background: $feedback_link_bg; */
1.599     albertel 6653:   font-size: larger;
                   6654:   position: absolute;
                   6655:   right: 1em;
1.489     raeburn  6656: }
1.421     albertel 6657: 
1.515     albertel 6658: table.LC_prior_tries {
1.524     albertel 6659:   border: 1px solid #000000;
                   6660:   border-collapse: separate;
                   6661:   border-spacing: 1px;
1.515     albertel 6662: }
1.523     albertel 6663: 
1.515     albertel 6664: table.LC_prior_tries td {
1.524     albertel 6665:   padding: 2px;
1.515     albertel 6666: }
1.523     albertel 6667: 
                   6668: .LC_answer_correct {
1.795     www      6669:   background: lightgreen;
                   6670:   color: darkgreen;
                   6671:   padding: 6px;
1.523     albertel 6672: }
1.795     www      6673: 
1.523     albertel 6674: .LC_answer_charged_try {
1.797     www      6675:   background: #FFAAAA;
1.795     www      6676:   color: darkred;
                   6677:   padding: 6px;
1.523     albertel 6678: }
1.795     www      6679: 
1.779     bisitz   6680: .LC_answer_not_charged_try,
1.523     albertel 6681: .LC_answer_no_grade,
                   6682: .LC_answer_late {
1.795     www      6683:   background: lightyellow;
1.523     albertel 6684:   color: black;
1.795     www      6685:   padding: 6px;
1.523     albertel 6686: }
1.795     www      6687: 
1.523     albertel 6688: .LC_answer_previous {
1.795     www      6689:   background: lightblue;
                   6690:   color: darkblue;
                   6691:   padding: 6px;
1.523     albertel 6692: }
1.795     www      6693: 
1.779     bisitz   6694: .LC_answer_no_message {
1.777     tempelho 6695:   background: #FFFFFF;
                   6696:   color: black;
1.795     www      6697:   padding: 6px;
1.779     bisitz   6698: }
1.795     www      6699: 
1.779     bisitz   6700: .LC_answer_unknown {
                   6701:   background: orange;
                   6702:   color: black;
1.795     www      6703:   padding: 6px;
1.777     tempelho 6704: }
1.795     www      6705: 
1.529     albertel 6706: span.LC_prior_numerical,
                   6707: span.LC_prior_string,
                   6708: span.LC_prior_custom,
                   6709: span.LC_prior_reaction,
                   6710: span.LC_prior_math {
1.925     bisitz   6711:   font-family: $mono;
1.523     albertel 6712:   white-space: pre;
                   6713: }
                   6714: 
1.525     albertel 6715: span.LC_prior_string {
1.925     bisitz   6716:   font-family: $mono;
1.525     albertel 6717:   white-space: pre;
                   6718: }
                   6719: 
1.523     albertel 6720: table.LC_prior_option {
                   6721:   width: 100%;
                   6722:   border-collapse: collapse;
                   6723: }
1.795     www      6724: 
1.911     bisitz   6725: table.LC_prior_rank,
1.795     www      6726: table.LC_prior_match {
1.528     albertel 6727:   border-collapse: collapse;
                   6728: }
1.795     www      6729: 
1.528     albertel 6730: table.LC_prior_option tr td,
                   6731: table.LC_prior_rank tr td,
                   6732: table.LC_prior_match tr td {
1.524     albertel 6733:   border: 1px solid #000000;
1.515     albertel 6734: }
                   6735: 
1.855     bisitz   6736: .LC_nobreak {
1.544     albertel 6737:   white-space: nowrap;
1.519     raeburn  6738: }
                   6739: 
1.576     raeburn  6740: span.LC_cusr_emph {
                   6741:   font-style: italic;
                   6742: }
                   6743: 
1.633     raeburn  6744: span.LC_cusr_subheading {
                   6745:   font-weight: normal;
                   6746:   font-size: 85%;
                   6747: }
                   6748: 
1.861     bisitz   6749: div.LC_docs_entry_move {
1.859     bisitz   6750:   border: 1px solid #BBBBBB;
1.545     albertel 6751:   background: #DDDDDD;
1.861     bisitz   6752:   width: 22px;
1.859     bisitz   6753:   padding: 1px;
                   6754:   margin: 0;
1.545     albertel 6755: }
                   6756: 
1.861     bisitz   6757: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6758: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6759:   font-size: x-small;
                   6760: }
1.795     www      6761: 
1.861     bisitz   6762: .LC_docs_entry_parameter {
                   6763:   white-space: nowrap;
                   6764: }
                   6765: 
1.544     albertel 6766: .LC_docs_copy {
1.545     albertel 6767:   color: #000099;
1.544     albertel 6768: }
1.795     www      6769: 
1.544     albertel 6770: .LC_docs_cut {
1.545     albertel 6771:   color: #550044;
1.544     albertel 6772: }
1.795     www      6773: 
1.544     albertel 6774: .LC_docs_rename {
1.545     albertel 6775:   color: #009900;
1.544     albertel 6776: }
1.795     www      6777: 
1.544     albertel 6778: .LC_docs_remove {
1.545     albertel 6779:   color: #990000;
                   6780: }
                   6781: 
1.547     albertel 6782: .LC_docs_reinit_warn,
                   6783: .LC_docs_ext_edit {
                   6784:   font-size: x-small;
                   6785: }
                   6786: 
1.545     albertel 6787: table.LC_docs_adddocs td,
                   6788: table.LC_docs_adddocs th {
                   6789:   border: 1px solid #BBBBBB;
                   6790:   padding: 4px;
                   6791:   background: #DDDDDD;
1.543     albertel 6792: }
                   6793: 
1.584     albertel 6794: table.LC_sty_begin {
                   6795:   background: #BBFFBB;
                   6796: }
1.795     www      6797: 
1.584     albertel 6798: table.LC_sty_end {
                   6799:   background: #FFBBBB;
                   6800: }
                   6801: 
1.589     raeburn  6802: table.LC_double_column {
1.803     bisitz   6803:   border-width: 0;
1.589     raeburn  6804:   border-collapse: collapse;
                   6805:   width: 100%;
                   6806:   padding: 2px;
                   6807: }
                   6808: 
                   6809: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6810:   top: 2px;
1.589     raeburn  6811:   left: 2px;
                   6812:   width: 47%;
                   6813:   vertical-align: top;
                   6814: }
                   6815: 
                   6816: table.LC_double_column tr td.LC_right_col {
                   6817:   top: 2px;
1.779     bisitz   6818:   right: 2px;
1.589     raeburn  6819:   width: 47%;
                   6820:   vertical-align: top;
                   6821: }
                   6822: 
1.591     raeburn  6823: div.LC_left_float {
                   6824:   float: left;
                   6825:   padding-right: 5%;
1.597     albertel 6826:   padding-bottom: 4px;
1.591     raeburn  6827: }
                   6828: 
                   6829: div.LC_clear_float_header {
1.597     albertel 6830:   padding-bottom: 2px;
1.591     raeburn  6831: }
                   6832: 
                   6833: div.LC_clear_float_footer {
1.597     albertel 6834:   padding-top: 10px;
1.591     raeburn  6835:   clear: both;
                   6836: }
                   6837: 
1.597     albertel 6838: div.LC_grade_show_user {
1.941     bisitz   6839: /*  border-left: 5px solid $sidebg; */
                   6840:   border-top: 5px solid #000000;
                   6841:   margin: 50px 0 0 0;
1.936     bisitz   6842:   padding: 15px 0 5px 10px;
1.597     albertel 6843: }
1.795     www      6844: 
1.936     bisitz   6845: div.LC_grade_show_user_odd_row {
1.941     bisitz   6846: /*  border-left: 5px solid #000000; */
                   6847: }
                   6848: 
                   6849: div.LC_grade_show_user div.LC_Box {
                   6850:   margin-right: 50px;
1.597     albertel 6851: }
                   6852: 
                   6853: div.LC_grade_submissions,
                   6854: div.LC_grade_message_center,
1.936     bisitz   6855: div.LC_grade_info_links {
1.597     albertel 6856:   margin: 5px;
                   6857:   width: 99%;
                   6858:   background: #FFFFFF;
                   6859: }
1.795     www      6860: 
1.597     albertel 6861: div.LC_grade_submissions_header,
1.936     bisitz   6862: div.LC_grade_message_center_header {
1.705     tempelho 6863:   font-weight: bold;
                   6864:   font-size: large;
1.597     albertel 6865: }
1.795     www      6866: 
1.597     albertel 6867: div.LC_grade_submissions_body,
1.936     bisitz   6868: div.LC_grade_message_center_body {
1.597     albertel 6869:   border: 1px solid black;
                   6870:   width: 99%;
                   6871:   background: #FFFFFF;
                   6872: }
1.795     www      6873: 
1.613     albertel 6874: table.LC_scantron_action {
                   6875:   width: 100%;
                   6876: }
1.795     www      6877: 
1.613     albertel 6878: table.LC_scantron_action tr th {
1.698     harmsja  6879:   font-weight:bold;
                   6880:   font-style:normal;
1.613     albertel 6881: }
1.795     www      6882: 
1.779     bisitz   6883: .LC_edit_problem_header,
1.614     albertel 6884: div.LC_edit_problem_footer {
1.705     tempelho 6885:   font-weight: normal;
                   6886:   font-size:  medium;
1.602     albertel 6887:   margin: 2px;
1.1060    bisitz   6888:   background-color: $sidebg;
1.600     albertel 6889: }
1.795     www      6890: 
1.600     albertel 6891: div.LC_edit_problem_header,
1.602     albertel 6892: div.LC_edit_problem_header div,
1.614     albertel 6893: div.LC_edit_problem_footer,
                   6894: div.LC_edit_problem_footer div,
1.602     albertel 6895: div.LC_edit_problem_editxml_header,
                   6896: div.LC_edit_problem_editxml_header div {
1.1205    golterma 6897:   z-index: 100;
1.600     albertel 6898: }
1.795     www      6899: 
1.600     albertel 6900: div.LC_edit_problem_header_title {
1.705     tempelho 6901:   font-weight: bold;
                   6902:   font-size: larger;
1.602     albertel 6903:   background: $tabbg;
                   6904:   padding: 3px;
1.1060    bisitz   6905:   margin: 0 0 5px 0;
1.602     albertel 6906: }
1.795     www      6907: 
1.602     albertel 6908: table.LC_edit_problem_header_title {
                   6909:   width: 100%;
1.600     albertel 6910:   background: $tabbg;
1.602     albertel 6911: }
                   6912: 
1.1205    golterma 6913: div.LC_edit_actionbar {
                   6914:     background-color: $sidebg;
1.1218    droeschl 6915:     margin: 0;
                   6916:     padding: 0;
                   6917:     line-height: 200%;
1.602     albertel 6918: }
1.795     www      6919: 
1.1218    droeschl 6920: div.LC_edit_actionbar div{
                   6921:     padding: 0;
                   6922:     margin: 0;
                   6923:     display: inline-block;
1.600     albertel 6924: }
1.795     www      6925: 
1.1124    bisitz   6926: .LC_edit_opt {
                   6927:   padding-left: 1em;
                   6928:   white-space: nowrap;
                   6929: }
                   6930: 
1.1152    golterma 6931: .LC_edit_problem_latexhelper{
                   6932:     text-align: right;
                   6933: }
                   6934: 
                   6935: #LC_edit_problem_colorful div{
                   6936:     margin-left: 40px;
                   6937: }
                   6938: 
1.1205    golterma 6939: #LC_edit_problem_codemirror div{
                   6940:     margin-left: 0px;
                   6941: }
                   6942: 
1.911     bisitz   6943: img.stift {
1.803     bisitz   6944:   border-width: 0;
                   6945:   vertical-align: middle;
1.677     riegler  6946: }
1.680     riegler  6947: 
1.923     bisitz   6948: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6949:   vertical-align: top;
1.777     tempelho 6950: }
1.795     www      6951: 
1.716     raeburn  6952: div.LC_createcourse {
1.911     bisitz   6953:   margin: 10px 10px 10px 10px;
1.716     raeburn  6954: }
                   6955: 
1.917     raeburn  6956: .LC_dccid {
1.1130    raeburn  6957:   float: right;
1.917     raeburn  6958:   margin: 0.2em 0 0 0;
                   6959:   padding: 0;
                   6960:   font-size: 90%;
                   6961:   display:none;
                   6962: }
                   6963: 
1.897     wenzelju 6964: ol.LC_primary_menu a:hover,
1.721     harmsja  6965: ol#LC_MenuBreadcrumbs a:hover,
                   6966: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6967: ul#LC_secondary_menu a:hover,
1.721     harmsja  6968: .LC_FormSectionClearButton input:hover
1.795     www      6969: ul.LC_TabContent   li:hover a {
1.952     onken    6970:   color:$button_hover;
1.911     bisitz   6971:   text-decoration:none;
1.693     droeschl 6972: }
                   6973: 
1.779     bisitz   6974: h1 {
1.911     bisitz   6975:   padding: 0;
                   6976:   line-height:130%;
1.693     droeschl 6977: }
1.698     harmsja  6978: 
1.911     bisitz   6979: h2,
                   6980: h3,
                   6981: h4,
                   6982: h5,
                   6983: h6 {
                   6984:   margin: 5px 0 5px 0;
                   6985:   padding: 0;
                   6986:   line-height:130%;
1.693     droeschl 6987: }
1.795     www      6988: 
                   6989: .LC_hcell {
1.911     bisitz   6990:   padding:3px 15px 3px 15px;
                   6991:   margin: 0;
                   6992:   background-color:$tabbg;
                   6993:   color:$fontmenu;
                   6994:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6995: }
1.795     www      6996: 
1.840     bisitz   6997: .LC_Box > .LC_hcell {
1.911     bisitz   6998:   margin: 0 -10px 10px -10px;
1.835     bisitz   6999: }
                   7000: 
1.721     harmsja  7001: .LC_noBorder {
1.911     bisitz   7002:   border: 0;
1.698     harmsja  7003: }
1.693     droeschl 7004: 
1.721     harmsja  7005: .LC_FormSectionClearButton input {
1.911     bisitz   7006:   background-color:transparent;
                   7007:   border: none;
                   7008:   cursor:pointer;
                   7009:   text-decoration:underline;
1.693     droeschl 7010: }
1.763     bisitz   7011: 
                   7012: .LC_help_open_topic {
1.911     bisitz   7013:   color: #FFFFFF;
                   7014:   background-color: #EEEEFF;
                   7015:   margin: 1px;
                   7016:   padding: 4px;
                   7017:   border: 1px solid #000033;
                   7018:   white-space: nowrap;
                   7019:   /* vertical-align: middle; */
1.759     neumanie 7020: }
1.693     droeschl 7021: 
1.911     bisitz   7022: dl,
                   7023: ul,
                   7024: div,
                   7025: fieldset {
                   7026:   margin: 10px 10px 10px 0;
                   7027:   /* overflow: hidden; */
1.693     droeschl 7028: }
1.795     www      7029: 
1.1211    raeburn  7030: article.geogebraweb div {
                   7031:     margin: 0;
                   7032: }
                   7033: 
1.838     bisitz   7034: fieldset > legend {
1.911     bisitz   7035:   font-weight: bold;
                   7036:   padding: 0 5px 0 5px;
1.838     bisitz   7037: }
                   7038: 
1.813     bisitz   7039: #LC_nav_bar {
1.911     bisitz   7040:   float: left;
1.995     raeburn  7041:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   7042:   margin: 0 0 2px 0;
1.807     droeschl 7043: }
                   7044: 
1.916     droeschl 7045: #LC_realm {
                   7046:   margin: 0.2em 0 0 0;
                   7047:   padding: 0;
                   7048:   font-weight: bold;
                   7049:   text-align: center;
1.995     raeburn  7050:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7051: }
                   7052: 
1.911     bisitz   7053: #LC_nav_bar em {
                   7054:   font-weight: bold;
                   7055:   font-style: normal;
1.807     droeschl 7056: }
                   7057: 
1.897     wenzelju 7058: ol.LC_primary_menu {
1.934     droeschl 7059:   margin: 0;
1.1076    raeburn  7060:   padding: 0;
1.807     droeschl 7061: }
                   7062: 
1.852     droeschl 7063: ol#LC_PathBreadcrumbs {
1.911     bisitz   7064:   margin: 0;
1.693     droeschl 7065: }
                   7066: 
1.897     wenzelju 7067: ol.LC_primary_menu li {
1.1076    raeburn  7068:   color: RGB(80, 80, 80);
                   7069:   vertical-align: middle;
                   7070:   text-align: left;
                   7071:   list-style: none;
1.1205    golterma 7072:   position: relative;
1.1076    raeburn  7073:   float: left;
1.1205    golterma 7074:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7075:   line-height: 1.5em;
1.1076    raeburn  7076: }
                   7077: 
1.1205    golterma 7078: ol.LC_primary_menu li a,
                   7079: ol.LC_primary_menu li p {
1.1076    raeburn  7080:   display: block;
                   7081:   margin: 0;
                   7082:   padding: 0 5px 0 10px;
                   7083:   text-decoration: none;
                   7084: }
                   7085: 
1.1205    golterma 7086: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   7087:   display: inline-block;
                   7088:   width: 95%;
                   7089:   text-align: left;
                   7090: }
                   7091: 
                   7092: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   7093:   display: inline-block;	
                   7094:   width: 5%;
                   7095:   float: right;
                   7096:   text-align: right;
                   7097:   font-size: 70%;
                   7098: }
                   7099: 
                   7100: ol.LC_primary_menu ul {
1.1076    raeburn  7101:   display: none;
1.1205    golterma 7102:   width: 15em;
1.1076    raeburn  7103:   background-color: $data_table_light;
1.1205    golterma 7104:   position: absolute;
                   7105:   top: 100%;
1.1076    raeburn  7106: }
                   7107: 
1.1205    golterma 7108: ol.LC_primary_menu ul ul {
                   7109:   left: 100%;
                   7110:   top: 0;
                   7111: }
                   7112: 
                   7113: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076    raeburn  7114:   display: block;
                   7115:   position: absolute;
                   7116:   margin: 0;
                   7117:   padding: 0;
1.1078    raeburn  7118:   z-index: 2;
1.1076    raeburn  7119: }
                   7120: 
                   7121: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205    golterma 7122: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076    raeburn  7123:   font-size: 90%;
1.911     bisitz   7124:   vertical-align: top;
1.1076    raeburn  7125:   float: none;
1.1079    raeburn  7126:   border-left: 1px solid black;
                   7127:   border-right: 1px solid black;
1.1205    golterma 7128: /* A dark bottom border to visualize different menu options; 
                   7129: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   7130:   border-bottom: 1px solid $data_table_dark; 
1.1076    raeburn  7131: }
                   7132: 
1.1205    golterma 7133: ol.LC_primary_menu li li p:hover {
                   7134:   color:$button_hover;
                   7135:   text-decoration:none;
                   7136:   background-color:$data_table_dark;
1.1076    raeburn  7137: }
                   7138: 
                   7139: ol.LC_primary_menu li li a:hover {
                   7140:    color:$button_hover;
                   7141:    background-color:$data_table_dark;
1.693     droeschl 7142: }
                   7143: 
1.1205    golterma 7144: /* Font-size equal to the size of the predecessors*/
                   7145: ol.LC_primary_menu li:hover li li {
                   7146:   font-size: 100%;
                   7147: }
                   7148: 
1.897     wenzelju 7149: ol.LC_primary_menu li img {
1.911     bisitz   7150:   vertical-align: bottom;
1.934     droeschl 7151:   height: 1.1em;
1.1077    raeburn  7152:   margin: 0.2em 0 0 0;
1.693     droeschl 7153: }
                   7154: 
1.897     wenzelju 7155: ol.LC_primary_menu a {
1.911     bisitz   7156:   color: RGB(80, 80, 80);
                   7157:   text-decoration: none;
1.693     droeschl 7158: }
1.795     www      7159: 
1.949     droeschl 7160: ol.LC_primary_menu a.LC_new_message {
                   7161:   font-weight:bold;
                   7162:   color: darkred;
                   7163: }
                   7164: 
1.975     raeburn  7165: ol.LC_docs_parameters {
                   7166:   margin-left: 0;
                   7167:   padding: 0;
                   7168:   list-style: none;
                   7169: }
                   7170: 
                   7171: ol.LC_docs_parameters li {
                   7172:   margin: 0;
                   7173:   padding-right: 20px;
                   7174:   display: inline;
                   7175: }
                   7176: 
1.976     raeburn  7177: ol.LC_docs_parameters li:before {
                   7178:   content: "\\002022 \\0020";
                   7179: }
                   7180: 
                   7181: li.LC_docs_parameters_title {
                   7182:   font-weight: bold;
                   7183: }
                   7184: 
                   7185: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   7186:   content: "";
                   7187: }
                   7188: 
1.897     wenzelju 7189: ul#LC_secondary_menu {
1.1107    raeburn  7190:   clear: right;
1.911     bisitz   7191:   color: $fontmenu;
                   7192:   background: $tabbg;
                   7193:   list-style: none;
                   7194:   padding: 0;
                   7195:   margin: 0;
                   7196:   width: 100%;
1.995     raeburn  7197:   text-align: left;
1.1107    raeburn  7198:   float: left;
1.808     droeschl 7199: }
                   7200: 
1.897     wenzelju 7201: ul#LC_secondary_menu li {
1.911     bisitz   7202:   font-weight: bold;
                   7203:   line-height: 1.8em;
1.1107    raeburn  7204:   border-right: 1px solid black;
                   7205:   float: left;
                   7206: }
                   7207: 
                   7208: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   7209:   background-color: $data_table_light;
                   7210: }
                   7211: 
                   7212: ul#LC_secondary_menu li a {
1.911     bisitz   7213:   padding: 0 0.8em;
1.1107    raeburn  7214: }
                   7215: 
                   7216: ul#LC_secondary_menu li ul {
                   7217:   display: none;
                   7218: }
                   7219: 
                   7220: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   7221:   display: block;
                   7222:   position: absolute;
                   7223:   margin: 0;
                   7224:   padding: 0;
                   7225:   list-style:none;
                   7226:   float: none;
                   7227:   background-color: $data_table_light;
                   7228:   z-index: 2;
                   7229:   margin-left: -1px;
                   7230: }
                   7231: 
                   7232: ul#LC_secondary_menu li ul li {
                   7233:   font-size: 90%;
                   7234:   vertical-align: top;
                   7235:   border-left: 1px solid black;
1.911     bisitz   7236:   border-right: 1px solid black;
1.1119    raeburn  7237:   background-color: $data_table_light;
1.1107    raeburn  7238:   list-style:none;
                   7239:   float: none;
                   7240: }
                   7241: 
                   7242: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   7243:   background-color: $data_table_dark;
1.807     droeschl 7244: }
                   7245: 
1.847     tempelho 7246: ul.LC_TabContent {
1.911     bisitz   7247:   display:block;
                   7248:   background: $sidebg;
                   7249:   border-bottom: solid 1px $lg_border_color;
                   7250:   list-style:none;
1.1020    raeburn  7251:   margin: -1px -10px 0 -10px;
1.911     bisitz   7252:   padding: 0;
1.693     droeschl 7253: }
                   7254: 
1.795     www      7255: ul.LC_TabContent li,
                   7256: ul.LC_TabContentBigger li {
1.911     bisitz   7257:   float:left;
1.741     harmsja  7258: }
1.795     www      7259: 
1.897     wenzelju 7260: ul#LC_secondary_menu li a {
1.911     bisitz   7261:   color: $fontmenu;
                   7262:   text-decoration: none;
1.693     droeschl 7263: }
1.795     www      7264: 
1.721     harmsja  7265: ul.LC_TabContent {
1.952     onken    7266:   min-height:20px;
1.721     harmsja  7267: }
1.795     www      7268: 
                   7269: ul.LC_TabContent li {
1.911     bisitz   7270:   vertical-align:middle;
1.959     onken    7271:   padding: 0 16px 0 10px;
1.911     bisitz   7272:   background-color:$tabbg;
                   7273:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  7274:   border-left: solid 1px $font;
1.721     harmsja  7275: }
1.795     www      7276: 
1.847     tempelho 7277: ul.LC_TabContent .right {
1.911     bisitz   7278:   float:right;
1.847     tempelho 7279: }
                   7280: 
1.911     bisitz   7281: ul.LC_TabContent li a,
                   7282: ul.LC_TabContent li {
                   7283:   color:rgb(47,47,47);
                   7284:   text-decoration:none;
                   7285:   font-size:95%;
                   7286:   font-weight:bold;
1.952     onken    7287:   min-height:20px;
                   7288: }
                   7289: 
1.959     onken    7290: ul.LC_TabContent li a:hover,
                   7291: ul.LC_TabContent li a:focus {
1.952     onken    7292:   color: $button_hover;
1.959     onken    7293:   background:none;
                   7294:   outline:none;
1.952     onken    7295: }
                   7296: 
                   7297: ul.LC_TabContent li:hover {
                   7298:   color: $button_hover;
                   7299:   cursor:pointer;
1.721     harmsja  7300: }
1.795     www      7301: 
1.911     bisitz   7302: ul.LC_TabContent li.active {
1.952     onken    7303:   color: $font;
1.911     bisitz   7304:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    7305:   border-bottom:solid 1px #FFFFFF;
                   7306:   cursor: default;
1.744     ehlerst  7307: }
1.795     www      7308: 
1.959     onken    7309: ul.LC_TabContent li.active a {
                   7310:   color:$font;
                   7311:   background:#FFFFFF;
                   7312:   outline: none;
                   7313: }
1.1047    raeburn  7314: 
                   7315: ul.LC_TabContent li.goback {
                   7316:   float: left;
                   7317:   border-left: none;
                   7318: }
                   7319: 
1.870     tempelho 7320: #maincoursedoc {
1.911     bisitz   7321:   clear:both;
1.870     tempelho 7322: }
                   7323: 
                   7324: ul.LC_TabContentBigger {
1.911     bisitz   7325:   display:block;
                   7326:   list-style:none;
                   7327:   padding: 0;
1.870     tempelho 7328: }
                   7329: 
1.795     www      7330: ul.LC_TabContentBigger li {
1.911     bisitz   7331:   vertical-align:bottom;
                   7332:   height: 30px;
                   7333:   font-size:110%;
                   7334:   font-weight:bold;
                   7335:   color: #737373;
1.841     tempelho 7336: }
                   7337: 
1.957     onken    7338: ul.LC_TabContentBigger li.active {
                   7339:   position: relative;
                   7340:   top: 1px;
                   7341: }
                   7342: 
1.870     tempelho 7343: ul.LC_TabContentBigger li a {
1.911     bisitz   7344:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   7345:   height: 30px;
                   7346:   line-height: 30px;
                   7347:   text-align: center;
                   7348:   display: block;
                   7349:   text-decoration: none;
1.958     onken    7350:   outline: none;  
1.741     harmsja  7351: }
1.795     www      7352: 
1.870     tempelho 7353: ul.LC_TabContentBigger li.active a {
1.911     bisitz   7354:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   7355:   color:$font;
1.744     ehlerst  7356: }
1.795     www      7357: 
1.870     tempelho 7358: ul.LC_TabContentBigger li b {
1.911     bisitz   7359:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7360:   display: block;
                   7361:   float: left;
                   7362:   padding: 0 30px;
1.957     onken    7363:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7364: }
                   7365: 
1.956     onken    7366: ul.LC_TabContentBigger li:hover b {
                   7367:   color:$button_hover;
                   7368: }
                   7369: 
1.870     tempelho 7370: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7371:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7372:   color:$font;
1.957     onken    7373:   border: 0;
1.741     harmsja  7374: }
1.693     droeschl 7375: 
1.870     tempelho 7376: 
1.862     bisitz   7377: ul.LC_CourseBreadcrumbs {
                   7378:   background: $sidebg;
1.1020    raeburn  7379:   height: 2em;
1.862     bisitz   7380:   padding-left: 10px;
1.1020    raeburn  7381:   margin: 0;
1.862     bisitz   7382:   list-style-position: inside;
                   7383: }
                   7384: 
1.911     bisitz   7385: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7386: ol#LC_PathBreadcrumbs {
1.911     bisitz   7387:   padding-left: 10px;
                   7388:   margin: 0;
1.933     droeschl 7389:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7390: }
                   7391: 
1.911     bisitz   7392: ol#LC_MenuBreadcrumbs li,
                   7393: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7394: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7395:   display: inline;
1.933     droeschl 7396:   white-space: normal;  
1.693     droeschl 7397: }
                   7398: 
1.823     bisitz   7399: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7400: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7401:   text-decoration: none;
                   7402:   font-size:90%;
1.693     droeschl 7403: }
1.795     www      7404: 
1.969     droeschl 7405: ol#LC_MenuBreadcrumbs h1 {
                   7406:   display: inline;
                   7407:   font-size: 90%;
                   7408:   line-height: 2.5em;
                   7409:   margin: 0;
                   7410:   padding: 0;
                   7411: }
                   7412: 
1.795     www      7413: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7414:   text-decoration:none;
                   7415:   font-size:100%;
                   7416:   font-weight:bold;
1.693     droeschl 7417: }
1.795     www      7418: 
1.840     bisitz   7419: .LC_Box {
1.911     bisitz   7420:   border: solid 1px $lg_border_color;
                   7421:   padding: 0 10px 10px 10px;
1.746     neumanie 7422: }
1.795     www      7423: 
1.1020    raeburn  7424: .LC_DocsBox {
                   7425:   border: solid 1px $lg_border_color;
                   7426:   padding: 0 0 10px 10px;
                   7427: }
                   7428: 
1.795     www      7429: .LC_AboutMe_Image {
1.911     bisitz   7430:   float:left;
                   7431:   margin-right:10px;
1.747     neumanie 7432: }
1.795     www      7433: 
                   7434: .LC_Clear_AboutMe_Image {
1.911     bisitz   7435:   clear:left;
1.747     neumanie 7436: }
1.795     www      7437: 
1.721     harmsja  7438: dl.LC_ListStyleClean dt {
1.911     bisitz   7439:   padding-right: 5px;
                   7440:   display: table-header-group;
1.693     droeschl 7441: }
                   7442: 
1.721     harmsja  7443: dl.LC_ListStyleClean dd {
1.911     bisitz   7444:   display: table-row;
1.693     droeschl 7445: }
                   7446: 
1.721     harmsja  7447: .LC_ListStyleClean,
                   7448: .LC_ListStyleSimple,
                   7449: .LC_ListStyleNormal,
1.795     www      7450: .LC_ListStyleSpecial {
1.911     bisitz   7451:   /* display:block; */
                   7452:   list-style-position: inside;
                   7453:   list-style-type: none;
                   7454:   overflow: hidden;
                   7455:   padding: 0;
1.693     droeschl 7456: }
                   7457: 
1.721     harmsja  7458: .LC_ListStyleSimple li,
                   7459: .LC_ListStyleSimple dd,
                   7460: .LC_ListStyleNormal li,
                   7461: .LC_ListStyleNormal dd,
                   7462: .LC_ListStyleSpecial li,
1.795     www      7463: .LC_ListStyleSpecial dd {
1.911     bisitz   7464:   margin: 0;
                   7465:   padding: 5px 5px 5px 10px;
                   7466:   clear: both;
1.693     droeschl 7467: }
                   7468: 
1.721     harmsja  7469: .LC_ListStyleClean li,
                   7470: .LC_ListStyleClean dd {
1.911     bisitz   7471:   padding-top: 0;
                   7472:   padding-bottom: 0;
1.693     droeschl 7473: }
                   7474: 
1.721     harmsja  7475: .LC_ListStyleSimple dd,
1.795     www      7476: .LC_ListStyleSimple li {
1.911     bisitz   7477:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7478: }
                   7479: 
1.721     harmsja  7480: .LC_ListStyleSpecial li,
                   7481: .LC_ListStyleSpecial dd {
1.911     bisitz   7482:   list-style-type: none;
                   7483:   background-color: RGB(220, 220, 220);
                   7484:   margin-bottom: 4px;
1.693     droeschl 7485: }
                   7486: 
1.721     harmsja  7487: table.LC_SimpleTable {
1.911     bisitz   7488:   margin:5px;
                   7489:   border:solid 1px $lg_border_color;
1.795     www      7490: }
1.693     droeschl 7491: 
1.721     harmsja  7492: table.LC_SimpleTable tr {
1.911     bisitz   7493:   padding: 0;
                   7494:   border:solid 1px $lg_border_color;
1.693     droeschl 7495: }
1.795     www      7496: 
                   7497: table.LC_SimpleTable thead {
1.911     bisitz   7498:   background:rgb(220,220,220);
1.693     droeschl 7499: }
                   7500: 
1.721     harmsja  7501: div.LC_columnSection {
1.911     bisitz   7502:   display: block;
                   7503:   clear: both;
                   7504:   overflow: hidden;
                   7505:   margin: 0;
1.693     droeschl 7506: }
                   7507: 
1.721     harmsja  7508: div.LC_columnSection>* {
1.911     bisitz   7509:   float: left;
                   7510:   margin: 10px 20px 10px 0;
                   7511:   overflow:hidden;
1.693     droeschl 7512: }
1.721     harmsja  7513: 
1.795     www      7514: table em {
1.911     bisitz   7515:   font-weight: bold;
                   7516:   font-style: normal;
1.748     schulted 7517: }
1.795     www      7518: 
1.779     bisitz   7519: table.LC_tableBrowseRes,
1.795     www      7520: table.LC_tableOfContent {
1.911     bisitz   7521:   border:none;
                   7522:   border-spacing: 1px;
                   7523:   padding: 3px;
                   7524:   background-color: #FFFFFF;
                   7525:   font-size: 90%;
1.753     droeschl 7526: }
1.789     droeschl 7527: 
1.911     bisitz   7528: table.LC_tableOfContent {
                   7529:   border-collapse: collapse;
1.789     droeschl 7530: }
                   7531: 
1.771     droeschl 7532: table.LC_tableBrowseRes a,
1.768     schulted 7533: table.LC_tableOfContent a {
1.911     bisitz   7534:   background-color: transparent;
                   7535:   text-decoration: none;
1.753     droeschl 7536: }
                   7537: 
1.795     www      7538: table.LC_tableOfContent img {
1.911     bisitz   7539:   border: none;
                   7540:   height: 1.3em;
                   7541:   vertical-align: text-bottom;
                   7542:   margin-right: 0.3em;
1.753     droeschl 7543: }
1.757     schulted 7544: 
1.795     www      7545: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7546:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7547: }
                   7548: 
1.795     www      7549: a#LC_content_toolbar_everything {
1.911     bisitz   7550:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7551: }
                   7552: 
1.795     www      7553: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7554:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7555: }
                   7556: 
1.795     www      7557: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7558:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7559: }
                   7560: 
1.795     www      7561: a#LC_content_toolbar_changefolder {
1.911     bisitz   7562:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7563: }
                   7564: 
1.795     www      7565: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7566:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7567: }
                   7568: 
1.1043    raeburn  7569: a#LC_content_toolbar_edittoplevel {
                   7570:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7571: }
                   7572: 
1.795     www      7573: ul#LC_toolbar li a:hover {
1.911     bisitz   7574:   background-position: bottom center;
1.757     schulted 7575: }
                   7576: 
1.795     www      7577: ul#LC_toolbar {
1.911     bisitz   7578:   padding: 0;
                   7579:   margin: 2px;
                   7580:   list-style:none;
                   7581:   position:relative;
                   7582:   background-color:white;
1.1082    raeburn  7583:   overflow: auto;
1.757     schulted 7584: }
                   7585: 
1.795     www      7586: ul#LC_toolbar li {
1.911     bisitz   7587:   border:1px solid white;
                   7588:   padding: 0;
                   7589:   margin: 0;
                   7590:   float: left;
                   7591:   display:inline;
                   7592:   vertical-align:middle;
1.1082    raeburn  7593:   white-space: nowrap;
1.911     bisitz   7594: }
1.757     schulted 7595: 
1.783     amueller 7596: 
1.795     www      7597: a.LC_toolbarItem {
1.911     bisitz   7598:   display:block;
                   7599:   padding: 0;
                   7600:   margin: 0;
                   7601:   height: 32px;
                   7602:   width: 32px;
                   7603:   color:white;
                   7604:   border: none;
                   7605:   background-repeat:no-repeat;
                   7606:   background-color:transparent;
1.757     schulted 7607: }
                   7608: 
1.915     droeschl 7609: ul.LC_funclist {
                   7610:     margin: 0;
                   7611:     padding: 0.5em 1em 0.5em 0;
                   7612: }
                   7613: 
1.933     droeschl 7614: ul.LC_funclist > li:first-child {
                   7615:     font-weight:bold; 
                   7616:     margin-left:0.8em;
                   7617: }
                   7618: 
1.915     droeschl 7619: ul.LC_funclist + ul.LC_funclist {
                   7620:     /* 
                   7621:        left border as a seperator if we have more than
                   7622:        one list 
                   7623:     */
                   7624:     border-left: 1px solid $sidebg;
                   7625:     /* 
                   7626:        this hides the left border behind the border of the 
                   7627:        outer box if element is wrapped to the next 'line' 
                   7628:     */
                   7629:     margin-left: -1px;
                   7630: }
                   7631: 
1.843     bisitz   7632: ul.LC_funclist li {
1.915     droeschl 7633:   display: inline;
1.782     bisitz   7634:   white-space: nowrap;
1.915     droeschl 7635:   margin: 0 0 0 25px;
                   7636:   line-height: 150%;
1.782     bisitz   7637: }
                   7638: 
1.974     wenzelju 7639: .LC_hidden {
                   7640:   display: none;
                   7641: }
                   7642: 
1.1030    www      7643: .LCmodal-overlay {
                   7644: 		position:fixed;
                   7645: 		top:0;
                   7646: 		right:0;
                   7647: 		bottom:0;
                   7648: 		left:0;
                   7649: 		height:100%;
                   7650: 		width:100%;
                   7651: 		margin:0;
                   7652: 		padding:0;
                   7653: 		background:#999;
                   7654: 		opacity:.75;
                   7655: 		filter: alpha(opacity=75);
                   7656: 		-moz-opacity: 0.75;
                   7657: 		z-index:101;
                   7658: }
                   7659: 
                   7660: * html .LCmodal-overlay {   
                   7661: 		position: absolute;
                   7662: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7663: }
                   7664: 
                   7665: .LCmodal-window {
                   7666: 		position:fixed;
                   7667: 		top:50%;
                   7668: 		left:50%;
                   7669: 		margin:0;
                   7670: 		padding:0;
                   7671: 		z-index:102;
                   7672: 	}
                   7673: 
                   7674: * html .LCmodal-window {
                   7675: 		position:absolute;
                   7676: }
                   7677: 
                   7678: .LCclose-window {
                   7679: 		position:absolute;
                   7680: 		width:32px;
                   7681: 		height:32px;
                   7682: 		right:8px;
                   7683: 		top:8px;
                   7684: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7685: 		text-indent:-99999px;
                   7686: 		overflow:hidden;
                   7687: 		cursor:pointer;
                   7688: }
                   7689: 
1.1100    raeburn  7690: /*
1.1231    damieng  7691:   styles used for response display
                   7692: */
                   7693: div.LC_radiofoil, div.LC_rankfoil {
                   7694:   margin: .5em 0em .5em 0em;
                   7695: }
                   7696: table.LC_itemgroup {
                   7697:   margin-top: 1em;
                   7698: }
                   7699: 
                   7700: /*
1.1100    raeburn  7701:   styles used by TTH when "Default set of options to pass to tth/m
                   7702:   when converting TeX" in course settings has been set
                   7703: 
                   7704:   option passed: -t
                   7705: 
                   7706: */
                   7707: 
                   7708: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7709: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7710: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7711: td div.norm {line-height:normal;}
                   7712: 
                   7713: /*
                   7714:   option passed -y3
                   7715: */
                   7716: 
                   7717: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7718: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7719: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7720: 
1.1230    damieng  7721: /*
                   7722:   sections with roles, for content only
                   7723: */
                   7724: section[class^="role-"] {
                   7725:   padding-left: 10px;
                   7726:   padding-right: 5px;
                   7727:   margin-top: 8px;
                   7728:   margin-bottom: 8px;
                   7729:   border: 1px solid #2A4;
                   7730:   border-radius: 5px;
                   7731:   box-shadow: 0px 1px 1px #BBB;
                   7732: }
                   7733: section[class^="role-"]>h1 {
                   7734:   position: relative;
                   7735:   margin: 0px;
                   7736:   padding-top: 10px;
                   7737:   padding-left: 40px;
                   7738: }
                   7739: section[class^="role-"]>h1:before {
                   7740:   position: absolute;
                   7741:   left: -5px;
                   7742:   top: 5px;
                   7743: }
                   7744: section.role-activity>h1:before {
                   7745:   content:url('/adm/daxe/images/section_icons/activity.png');
                   7746: }
                   7747: section.role-advice>h1:before {
                   7748:   content:url('/adm/daxe/images/section_icons/advice.png');
                   7749: }
                   7750: section.role-bibliography>h1:before {
                   7751:   content:url('/adm/daxe/images/section_icons/bibliography.png');
                   7752: }
                   7753: section.role-citation>h1:before {
                   7754:   content:url('/adm/daxe/images/section_icons/citation.png');
                   7755: }
                   7756: section.role-conclusion>h1:before {
                   7757:   content:url('/adm/daxe/images/section_icons/conclusion.png');
                   7758: }
                   7759: section.role-definition>h1:before {
                   7760:   content:url('/adm/daxe/images/section_icons/definition.png');
                   7761: }
                   7762: section.role-demonstration>h1:before {
                   7763:   content:url('/adm/daxe/images/section_icons/demonstration.png');
                   7764: }
                   7765: section.role-example>h1:before {
                   7766:   content:url('/adm/daxe/images/section_icons/example.png');
                   7767: }
                   7768: section.role-explanation>h1:before {
                   7769:   content:url('/adm/daxe/images/section_icons/explanation.png');
                   7770: }
                   7771: section.role-introduction>h1:before {
                   7772:   content:url('/adm/daxe/images/section_icons/introduction.png');
                   7773: }
                   7774: section.role-method>h1:before {
                   7775:   content:url('/adm/daxe/images/section_icons/method.png');
                   7776: }
                   7777: section.role-more_information>h1:before {
                   7778:   content:url('/adm/daxe/images/section_icons/more_information.png');
                   7779: }
                   7780: section.role-objectives>h1:before {
                   7781:   content:url('/adm/daxe/images/section_icons/objectives.png');
                   7782: }
                   7783: section.role-prerequisites>h1:before {
                   7784:   content:url('/adm/daxe/images/section_icons/prerequisites.png');
                   7785: }
                   7786: section.role-remark>h1:before {
                   7787:   content:url('/adm/daxe/images/section_icons/remark.png');
                   7788: }
                   7789: section.role-reminder>h1:before {
                   7790:   content:url('/adm/daxe/images/section_icons/reminder.png');
                   7791: }
                   7792: section.role-summary>h1:before {
                   7793:   content:url('/adm/daxe/images/section_icons/summary.png');
                   7794: }
                   7795: section.role-syntax>h1:before {
                   7796:   content:url('/adm/daxe/images/section_icons/syntax.png');
                   7797: }
                   7798: section.role-warning>h1:before {
                   7799:   content:url('/adm/daxe/images/section_icons/warning.png');
                   7800: }
                   7801: 
1.343     albertel 7802: END
                   7803: }
                   7804: 
1.306     albertel 7805: =pod
                   7806: 
                   7807: =item * &headtag()
                   7808: 
                   7809: Returns a uniform footer for LON-CAPA web pages.
                   7810: 
1.307     albertel 7811: Inputs: $title - optional title for the head
                   7812:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7813:         $args - optional arguments
1.319     albertel 7814:             force_register - if is true call registerurl so the remote is 
                   7815:                              informed
1.415     albertel 7816:             redirect       -> array ref of
                   7817:                                    1- seconds before redirect occurs
                   7818:                                    2- url to redirect to
                   7819:                                    3- whether the side effect should occur
1.315     albertel 7820:                            (side effect of setting 
                   7821:                                $env{'internal.head.redirect'} to the url 
                   7822:                                redirected too)
1.352     albertel 7823:             domain         -> force to color decorate a page for a specific
                   7824:                                domain
                   7825:             function       -> force usage of a specific rolish color scheme
                   7826:             bgcolor        -> override the default page bgcolor
1.460     albertel 7827:             no_auto_mt_title
                   7828:                            -> prevent &mt()ing the title arg
1.464     albertel 7829: 
1.306     albertel 7830: =cut
                   7831: 
                   7832: sub headtag {
1.313     albertel 7833:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7834:     
1.363     albertel 7835:     my $function = $args->{'function'} || &get_users_function();
                   7836:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7837:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  7838:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7839:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7840: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7841: 		   #time(),
1.418     albertel 7842: 		   $env{'environment.color.timestamp'},
1.363     albertel 7843: 		   $function,$domain,$bgcolor);
                   7844: 
1.369     www      7845:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7846: 
1.308     albertel 7847:     my $result =
                   7848: 	'<head>'.
1.1160    raeburn  7849: 	&font_settings($args);
1.319     albertel 7850: 
1.1188    raeburn  7851:     my $inhibitprint;
                   7852:     if ($args->{'print_suppress'}) {
                   7853:         $inhibitprint = &print_suppression();
                   7854:     }
1.1064    raeburn  7855: 
1.461     albertel 7856:     if (!$args->{'frameset'}) {
                   7857: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7858:     }
1.962     droeschl 7859:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7860:         $result .= Apache::lonxml::display_title();
1.319     albertel 7861:     }
1.436     albertel 7862:     if (!$args->{'no_nav_bar'} 
                   7863: 	&& !$args->{'only_body'}
                   7864: 	&& !$args->{'frameset'}) {
1.1154    raeburn  7865: 	$result .= &help_menu_js($httphost);
1.1032    www      7866:         $result.=&modal_window();
1.1038    www      7867:         $result.=&togglebox_script();
1.1034    www      7868:         $result.=&wishlist_window();
1.1041    www      7869:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7870:     } else {
                   7871:         if ($args->{'add_modal'}) {
                   7872:            $result.=&modal_window();
                   7873:         }
                   7874:         if ($args->{'add_wishlist'}) {
                   7875:            $result.=&wishlist_window();
                   7876:         }
1.1038    www      7877:         if ($args->{'add_togglebox'}) {
                   7878:            $result.=&togglebox_script();
                   7879:         }
1.1041    www      7880:         if ($args->{'add_progressbar'}) {
                   7881:            $result.=&LCprogressbarUpdate_script();
                   7882:         }
1.436     albertel 7883:     }
1.314     albertel 7884:     if (ref($args->{'redirect'})) {
1.414     albertel 7885: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7886: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7887: 	if (!$inhibit_continue) {
                   7888: 	    $env{'internal.head.redirect'} = $url;
                   7889: 	}
1.313     albertel 7890: 	$result.=<<ADDMETA
                   7891: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7892: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7893: ADDMETA
1.1210    raeburn  7894:     } else {
                   7895:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   7896:             my $requrl = $env{'request.uri'};
                   7897:             if ($requrl eq '') {
                   7898:                 $requrl = $ENV{'REQUEST_URI'};
                   7899:                 $requrl =~ s/\?.+$//;
                   7900:             }
                   7901:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   7902:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   7903:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   7904:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   7905:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   7906:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                   7907:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   7908:                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   7909:                         if ($domdefs{'offloadnow'}{$lonhost}) {
                   7910:                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                   7911:                             if (($newserver) && ($newserver ne $lonhost)) {
                   7912:                                 my $numsec = 5;
                   7913:                                 my $timeout = $numsec * 1000;
                   7914:                                 my ($newurl,$locknum,%locks,$msg);
                   7915:                                 if ($env{'request.role.adv'}) {
                   7916:                                     ($locknum,%locks) = &Apache::lonnet::get_locks();
                   7917:                                 }
                   7918:                                 my $disable_submit = 0;
                   7919:                                 if ($requrl =~ /$LONCAPA::assess_re/) {
                   7920:                                     $disable_submit = 1;
                   7921:                                 }
                   7922:                                 if ($locknum) {
                   7923:                                     my @lockinfo = sort(values(%locks));
                   7924:                                     $msg = &mt('Once the following tasks are complete: ')."\\n".
                   7925:                                            join(", ",sort(values(%locks)))."\\n".
                   7926:                                            &mt('your session will be transferred to a different server, after you click "Roles".');
                   7927:                                 } else {
                   7928:                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   7929:                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                   7930:                                     }
                   7931:                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   7932:                                     $newurl = '/adm/switchserver?otherserver='.$newserver;
                   7933:                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   7934:                                         $newurl .= '&role='.$env{'request.role'};
                   7935:                                     }
                   7936:                                     if ($env{'request.symb'}) {
                   7937:                                         $newurl .= '&symb='.$env{'request.symb'};
                   7938:                                     } else {
                   7939:                                         $newurl .= '&origurl='.$requrl;
                   7940:                                     }
                   7941:                                 }
1.1222    damieng  7942:                                 &js_escape(\$msg);
1.1210    raeburn  7943:                                 $result.=<<OFFLOAD
                   7944: <meta http-equiv="pragma" content="no-cache" />
                   7945: <script type="text/javascript">
1.1215    raeburn  7946: // <![CDATA[
1.1210    raeburn  7947: function LC_Offload_Now() {
                   7948:     var dest = "$newurl";
                   7949:     if (dest != '') {
                   7950:         window.location.href="$newurl";
                   7951:     }
                   7952: }
1.1214    raeburn  7953: \$(document).ready(function () {
                   7954:     window.alert('$msg');
                   7955:     if ($disable_submit) {
1.1210    raeburn  7956:         \$(".LC_hwk_submit").prop("disabled", true);
                   7957:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214    raeburn  7958:     }
                   7959:     setTimeout('LC_Offload_Now()', $timeout);
                   7960: });
1.1215    raeburn  7961: // ]]>
1.1210    raeburn  7962: </script>
                   7963: OFFLOAD
                   7964:                             }
                   7965:                         }
                   7966:                     }
                   7967:                 }
                   7968:             }
                   7969:         }
1.313     albertel 7970:     }
1.306     albertel 7971:     if (!defined($title)) {
                   7972: 	$title = 'The LearningOnline Network with CAPA';
                   7973:     }
1.460     albertel 7974:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7975:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  7976: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7977:     if (!$args->{'frameset'}) {
                   7978:         $result .= ' /';
                   7979:     }
                   7980:     $result .= '>' 
1.1064    raeburn  7981:         .$inhibitprint
1.414     albertel 7982: 	.$head_extra;
1.1242    raeburn  7983:     my $clientmobile;
                   7984:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   7985:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   7986:     } else {
                   7987:         $clientmobile = $env{'browser.mobile'};
                   7988:     }
                   7989:     if ($clientmobile) {
1.1137    raeburn  7990:         $result .= '
                   7991: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7992: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7993:     }
1.962     droeschl 7994:     return $result.'</head>';
1.306     albertel 7995: }
                   7996: 
                   7997: =pod
                   7998: 
1.340     albertel 7999: =item * &font_settings()
                   8000: 
                   8001: Returns neccessary <meta> to set the proper encoding
                   8002: 
1.1160    raeburn  8003: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 8004: 
                   8005: =cut
                   8006: 
                   8007: sub font_settings {
1.1160    raeburn  8008:     my ($args) = @_;
1.340     albertel 8009:     my $headerstring='';
1.1160    raeburn  8010:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   8011:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  8012:         $headerstring.=
                   8013:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   8014:         if (!$args->{'frameset'}) {
                   8015: 	    $headerstring.= ' /';
                   8016:         }
                   8017: 	$headerstring .= '>'."\n";
1.340     albertel 8018:     }
                   8019:     return $headerstring;
                   8020: }
                   8021: 
1.341     albertel 8022: =pod
                   8023: 
1.1064    raeburn  8024: =item * &print_suppression()
                   8025: 
                   8026: In course context returns css which causes the body to be blank when media="print",
                   8027: if printout generation is unavailable for the current resource.
                   8028: 
                   8029: This could be because:
                   8030: 
                   8031: (a) printstartdate is in the future
                   8032: 
                   8033: (b) printenddate is in the past
                   8034: 
                   8035: (c) there is an active exam block with "printout"
                   8036: functionality blocked
                   8037: 
                   8038: Users with pav, pfo or evb privileges are exempt.
                   8039: 
                   8040: Inputs: none
                   8041: 
                   8042: =cut
                   8043: 
                   8044: 
                   8045: sub print_suppression {
                   8046:     my $noprint;
                   8047:     if ($env{'request.course.id'}) {
                   8048:         my $scope = $env{'request.course.id'};
                   8049:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8050:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   8051:             return;
                   8052:         }
                   8053:         if ($env{'request.course.sec'} ne '') {
                   8054:             $scope .= "/$env{'request.course.sec'}";
                   8055:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8056:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  8057:                 return;
1.1064    raeburn  8058:             }
                   8059:         }
                   8060:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8061:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189    raeburn  8062:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  8063:         if ($blocked) {
                   8064:             my $checkrole = "cm./$cdom/$cnum";
                   8065:             if ($env{'request.course.sec'} ne '') {
                   8066:                 $checkrole .= "/$env{'request.course.sec'}";
                   8067:             }
                   8068:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   8069:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   8070:                 $noprint = 1;
                   8071:             }
                   8072:         }
                   8073:         unless ($noprint) {
                   8074:             my $symb = &Apache::lonnet::symbread();
                   8075:             if ($symb ne '') {
                   8076:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   8077:                 if (ref($navmap)) {
                   8078:                     my $res = $navmap->getBySymb($symb);
                   8079:                     if (ref($res)) {
                   8080:                         if (!$res->resprintable()) {
                   8081:                             $noprint = 1;
                   8082:                         }
                   8083:                     }
                   8084:                 }
                   8085:             }
                   8086:         }
                   8087:         if ($noprint) {
                   8088:             return <<"ENDSTYLE";
                   8089: <style type="text/css" media="print">
                   8090:     body { display:none }
                   8091: </style>
                   8092: ENDSTYLE
                   8093:         }
                   8094:     }
                   8095:     return;
                   8096: }
                   8097: 
                   8098: =pod
                   8099: 
1.341     albertel 8100: =item * &xml_begin()
                   8101: 
                   8102: Returns the needed doctype and <html>
                   8103: 
                   8104: Inputs: none
                   8105: 
                   8106: =cut
                   8107: 
                   8108: sub xml_begin {
1.1168    raeburn  8109:     my ($is_frameset) = @_;
1.341     albertel 8110:     my $output='';
                   8111: 
                   8112:     if ($env{'browser.mathml'}) {
                   8113: 	$output='<?xml version="1.0"?>'
                   8114:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   8115: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   8116:             
                   8117: #	    .'<!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">] >'
                   8118: 	    .'<!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">'
                   8119:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   8120: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  8121:     } elsif ($is_frameset) {
                   8122:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   8123:                 '<html>'."\n";
1.341     albertel 8124:     } else {
1.1168    raeburn  8125: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   8126:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 8127:     }
                   8128:     return $output;
                   8129: }
1.340     albertel 8130: 
                   8131: =pod
                   8132: 
1.306     albertel 8133: =item * &start_page()
                   8134: 
                   8135: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   8136: 
1.648     raeburn  8137: Inputs:
                   8138: 
                   8139: =over 4
                   8140: 
                   8141: $title - optional title for the page
                   8142: 
                   8143: $head_extra - optional extra HTML to incude inside the <head>
                   8144: 
                   8145: $args - additional optional args supported are:
                   8146: 
                   8147: =over 8
                   8148: 
                   8149:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 8150:                                     arg on
1.814     bisitz   8151:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  8152:              add_entries    -> additional attributes to add to the  <body>
                   8153:              domain         -> force to color decorate a page for a 
1.317     albertel 8154:                                     specific domain
1.648     raeburn  8155:              function       -> force usage of a specific rolish color
1.317     albertel 8156:                                     scheme
1.648     raeburn  8157:              redirect       -> see &headtag()
                   8158:              bgcolor        -> override the default page bg color
                   8159:              js_ready       -> return a string ready for being used in 
1.317     albertel 8160:                                     a javascript writeln
1.648     raeburn  8161:              html_encode    -> return a string ready for being used in 
1.320     albertel 8162:                                     a html attribute
1.648     raeburn  8163:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 8164:                                     $forcereg arg
1.648     raeburn  8165:              frameset       -> if true will start with a <frameset>
1.330     albertel 8166:                                     rather than <body>
1.648     raeburn  8167:              skip_phases    -> hash ref of 
1.338     albertel 8168:                                     head -> skip the <html><head> generation
                   8169:                                     body -> skip all <body> generation
1.648     raeburn  8170:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 8171:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  8172:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  8173:              group          -> includes the current group, if page is for a 
                   8174:                                specific group  
1.361     albertel 8175: 
1.648     raeburn  8176: =back
1.460     albertel 8177: 
1.648     raeburn  8178: =back
1.562     albertel 8179: 
1.306     albertel 8180: =cut
                   8181: 
                   8182: sub start_page {
1.309     albertel 8183:     my ($title,$head_extra,$args) = @_;
1.318     albertel 8184:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 8185: 
1.315     albertel 8186:     $env{'internal.start_page'}++;
1.1096    raeburn  8187:     my ($result,@advtools);
1.964     droeschl 8188: 
1.338     albertel 8189:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  8190:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 8191:     }
                   8192:     
                   8193:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   8194: 	if ($args->{'frameset'}) {
                   8195: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   8196: 						$args->{'add_entries'});
                   8197: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   8198:         } else {
                   8199:             $result .=
                   8200:                 &bodytag($title, 
                   8201:                          $args->{'function'},       $args->{'add_entries'},
                   8202:                          $args->{'only_body'},      $args->{'domain'},
                   8203:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  8204:                          $args->{'bgcolor'},        $args,
                   8205:                          \@advtools);
1.831     bisitz   8206:         }
1.330     albertel 8207:     }
1.338     albertel 8208: 
1.315     albertel 8209:     if ($args->{'js_ready'}) {
1.713     kaisler  8210: 		$result = &js_ready($result);
1.315     albertel 8211:     }
1.320     albertel 8212:     if ($args->{'html_encode'}) {
1.713     kaisler  8213: 		$result = &html_encode($result);
                   8214:     }
                   8215: 
1.813     bisitz   8216:     # Preparation for new and consistent functionlist at top of screen
                   8217:     # if ($args->{'functionlist'}) {
                   8218:     #            $result .= &build_functionlist();
                   8219:     #}
                   8220: 
1.964     droeschl 8221:     # Don't add anything more if only_body wanted or in const space
                   8222:     return $result if    $args->{'only_body'} 
                   8223:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   8224: 
                   8225:     #Breadcrumbs
1.758     kaisler  8226:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   8227: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   8228: 		#if any br links exists, add them to the breadcrumbs
                   8229: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   8230: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   8231: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   8232: 			}
                   8233: 		}
1.1096    raeburn  8234:                 # if @advtools array contains items add then to the breadcrumbs
                   8235:                 if (@advtools > 0) {
                   8236:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   8237:                 }
1.758     kaisler  8238: 
                   8239: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   8240: 		if(exists($args->{'bread_crumbs_component'})){
                   8241: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.1237    raeburn  8242: 		} elsif ($args->{'crstype'} eq 'Placement') {
                   8243: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
                   8244:                                                                        $args->{'crstype'});
                   8245:                 } else {
1.758     kaisler  8246: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   8247: 		}
1.320     albertel 8248:     }
1.315     albertel 8249:     return $result;
1.306     albertel 8250: }
                   8251: 
                   8252: sub end_page {
1.315     albertel 8253:     my ($args) = @_;
                   8254:     $env{'internal.end_page'}++;
1.330     albertel 8255:     my $result;
1.335     albertel 8256:     if ($args->{'discussion'}) {
                   8257: 	my ($target,$parser);
                   8258: 	if (ref($args->{'discussion'})) {
                   8259: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   8260: 				$args->{'discussion'}{'parser'});
                   8261: 	}
                   8262: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   8263:     }
1.330     albertel 8264:     if ($args->{'frameset'}) {
                   8265: 	$result .= '</frameset>';
                   8266:     } else {
1.635     raeburn  8267: 	$result .= &endbodytag($args);
1.330     albertel 8268:     }
1.1080    raeburn  8269:     unless ($args->{'notbody'}) {
                   8270:         $result .= "\n</html>";
                   8271:     }
1.330     albertel 8272: 
1.315     albertel 8273:     if ($args->{'js_ready'}) {
1.317     albertel 8274: 	$result = &js_ready($result);
1.315     albertel 8275:     }
1.335     albertel 8276: 
1.320     albertel 8277:     if ($args->{'html_encode'}) {
                   8278: 	$result = &html_encode($result);
                   8279:     }
1.335     albertel 8280: 
1.315     albertel 8281:     return $result;
                   8282: }
                   8283: 
1.1034    www      8284: sub wishlist_window {
                   8285:     return(<<'ENDWISHLIST');
1.1046    raeburn  8286: <script type="text/javascript">
1.1034    www      8287: // <![CDATA[
                   8288: // <!-- BEGIN LON-CAPA Internal
                   8289: function set_wishlistlink(title, path) {
                   8290:     if (!title) {
                   8291:         title = document.title;
                   8292:         title = title.replace(/^LON-CAPA /,'');
                   8293:     }
1.1175    raeburn  8294:     title = encodeURIComponent(title);
1.1203    raeburn  8295:     title = title.replace("'","\\\'");
1.1034    www      8296:     if (!path) {
                   8297:         path = location.pathname;
                   8298:     }
1.1175    raeburn  8299:     path = encodeURIComponent(path);
1.1203    raeburn  8300:     path = path.replace("'","\\\'");
1.1034    www      8301:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   8302:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   8303: }
                   8304: // END LON-CAPA Internal -->
                   8305: // ]]>
                   8306: </script>
                   8307: ENDWISHLIST
                   8308: }
                   8309: 
1.1030    www      8310: sub modal_window {
                   8311:     return(<<'ENDMODAL');
1.1046    raeburn  8312: <script type="text/javascript">
1.1030    www      8313: // <![CDATA[
                   8314: // <!-- BEGIN LON-CAPA Internal
                   8315: var modalWindow = {
                   8316: 	parent:"body",
                   8317: 	windowId:null,
                   8318: 	content:null,
                   8319: 	width:null,
                   8320: 	height:null,
                   8321: 	close:function()
                   8322: 	{
                   8323: 	        $(".LCmodal-window").remove();
                   8324: 	        $(".LCmodal-overlay").remove();
                   8325: 	},
                   8326: 	open:function()
                   8327: 	{
                   8328: 		var modal = "";
                   8329: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   8330: 		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;\">";
                   8331: 		modal += this.content;
                   8332: 		modal += "</div>";	
                   8333: 
                   8334: 		$(this.parent).append(modal);
                   8335: 
                   8336: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   8337: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   8338: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   8339: 	}
                   8340: };
1.1140    raeburn  8341: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      8342: 	{
1.1203    raeburn  8343:                 source = source.replace("'","&#39;");
1.1030    www      8344: 		modalWindow.windowId = "myModal";
                   8345: 		modalWindow.width = width;
                   8346: 		modalWindow.height = height;
1.1196    raeburn  8347: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      8348: 		modalWindow.open();
1.1208    raeburn  8349: 	};
1.1030    www      8350: // END LON-CAPA Internal -->
                   8351: // ]]>
                   8352: </script>
                   8353: ENDMODAL
                   8354: }
                   8355: 
                   8356: sub modal_link {
1.1140    raeburn  8357:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      8358:     unless ($width) { $width=480; }
                   8359:     unless ($height) { $height=400; }
1.1031    www      8360:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  8361:     unless ($transparency) { $transparency='true'; }
                   8362: 
1.1074    raeburn  8363:     my $target_attr;
                   8364:     if (defined($target)) {
                   8365:         $target_attr = 'target="'.$target.'"';
                   8366:     }
                   8367:     return <<"ENDLINK";
1.1140    raeburn  8368: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  8369:            $linktext</a>
                   8370: ENDLINK
1.1030    www      8371: }
                   8372: 
1.1032    www      8373: sub modal_adhoc_script {
                   8374:     my ($funcname,$width,$height,$content)=@_;
                   8375:     return (<<ENDADHOC);
1.1046    raeburn  8376: <script type="text/javascript">
1.1032    www      8377: // <![CDATA[
                   8378:         var $funcname = function()
                   8379:         {
                   8380:                 modalWindow.windowId = "myModal";
                   8381:                 modalWindow.width = $width;
                   8382:                 modalWindow.height = $height;
                   8383:                 modalWindow.content = '$content';
                   8384:                 modalWindow.open();
                   8385:         };  
                   8386: // ]]>
                   8387: </script>
                   8388: ENDADHOC
                   8389: }
                   8390: 
1.1041    www      8391: sub modal_adhoc_inner {
                   8392:     my ($funcname,$width,$height,$content)=@_;
                   8393:     my $innerwidth=$width-20;
                   8394:     $content=&js_ready(
1.1140    raeburn  8395:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   8396:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   8397:                  $content.
1.1041    www      8398:                  &end_scrollbox().
1.1140    raeburn  8399:                  &end_page()
1.1041    www      8400:              );
                   8401:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   8402: }
                   8403: 
                   8404: sub modal_adhoc_window {
                   8405:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   8406:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   8407:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   8408: }
                   8409: 
                   8410: sub modal_adhoc_launch {
                   8411:     my ($funcname,$width,$height,$content)=@_;
                   8412:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   8413: <script type="text/javascript">
                   8414: // <![CDATA[
                   8415: $funcname();
                   8416: // ]]>
                   8417: </script>
                   8418: ENDLAUNCH
                   8419: }
                   8420: 
                   8421: sub modal_adhoc_close {
                   8422:     return (<<ENDCLOSE);
                   8423: <script type="text/javascript">
                   8424: // <![CDATA[
                   8425: modalWindow.close();
                   8426: // ]]>
                   8427: </script>
                   8428: ENDCLOSE
                   8429: }
                   8430: 
1.1038    www      8431: sub togglebox_script {
                   8432:    return(<<ENDTOGGLE);
                   8433: <script type="text/javascript"> 
                   8434: // <![CDATA[
                   8435: function LCtoggleDisplay(id,hidetext,showtext) {
                   8436:    link = document.getElementById(id + "link").childNodes[0];
                   8437:    with (document.getElementById(id).style) {
                   8438:       if (display == "none" ) {
                   8439:           display = "inline";
                   8440:           link.nodeValue = hidetext;
                   8441:         } else {
                   8442:           display = "none";
                   8443:           link.nodeValue = showtext;
                   8444:        }
                   8445:    }
                   8446: }
                   8447: // ]]>
                   8448: </script>
                   8449: ENDTOGGLE
                   8450: }
                   8451: 
1.1039    www      8452: sub start_togglebox {
                   8453:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8454:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8455:     unless ($showtext) { $showtext=&mt('show'); }
                   8456:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8457:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8458:     return &start_data_table().
                   8459:            &start_data_table_header_row().
                   8460:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8461:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8462:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8463:            &end_data_table_header_row().
                   8464:            '<tr id="'.$id.'" style="display:none""><td>';
                   8465: }
                   8466: 
                   8467: sub end_togglebox {
                   8468:     return '</td></tr>'.&end_data_table();
                   8469: }
                   8470: 
1.1041    www      8471: sub LCprogressbar_script {
1.1045    www      8472:    my ($id)=@_;
1.1041    www      8473:    return(<<ENDPROGRESS);
                   8474: <script type="text/javascript">
                   8475: // <![CDATA[
1.1045    www      8476: \$('#progressbar$id').progressbar({
1.1041    www      8477:   value: 0,
                   8478:   change: function(event, ui) {
                   8479:     var newVal = \$(this).progressbar('option', 'value');
                   8480:     \$('.pblabel', this).text(LCprogressTxt);
                   8481:   }
                   8482: });
                   8483: // ]]>
                   8484: </script>
                   8485: ENDPROGRESS
                   8486: }
                   8487: 
                   8488: sub LCprogressbarUpdate_script {
                   8489:    return(<<ENDPROGRESSUPDATE);
                   8490: <style type="text/css">
                   8491: .ui-progressbar { position:relative; }
                   8492: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8493: </style>
                   8494: <script type="text/javascript">
                   8495: // <![CDATA[
1.1045    www      8496: var LCprogressTxt='---';
                   8497: 
                   8498: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      8499:    LCprogressTxt=progresstext;
1.1045    www      8500:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      8501: }
                   8502: // ]]>
                   8503: </script>
                   8504: ENDPROGRESSUPDATE
                   8505: }
                   8506: 
1.1042    www      8507: my $LClastpercent;
1.1045    www      8508: my $LCidcnt;
                   8509: my $LCcurrentid;
1.1042    www      8510: 
1.1041    www      8511: sub LCprogressbar {
1.1042    www      8512:     my ($r)=(@_);
                   8513:     $LClastpercent=0;
1.1045    www      8514:     $LCidcnt++;
                   8515:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      8516:     my $starting=&mt('Starting');
                   8517:     my $content=(<<ENDPROGBAR);
1.1045    www      8518:   <div id="progressbar$LCcurrentid">
1.1041    www      8519:     <span class="pblabel">$starting</span>
                   8520:   </div>
                   8521: ENDPROGBAR
1.1045    www      8522:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      8523: }
                   8524: 
                   8525: sub LCprogressbarUpdate {
1.1042    www      8526:     my ($r,$val,$text)=@_;
                   8527:     unless ($val) { 
                   8528:        if ($LClastpercent) {
                   8529:            $val=$LClastpercent;
                   8530:        } else {
                   8531:            $val=0;
                   8532:        }
                   8533:     }
1.1041    www      8534:     if ($val<0) { $val=0; }
                   8535:     if ($val>100) { $val=0; }
1.1042    www      8536:     $LClastpercent=$val;
1.1041    www      8537:     unless ($text) { $text=$val.'%'; }
                   8538:     $text=&js_ready($text);
1.1044    www      8539:     &r_print($r,<<ENDUPDATE);
1.1041    www      8540: <script type="text/javascript">
                   8541: // <![CDATA[
1.1045    www      8542: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      8543: // ]]>
                   8544: </script>
                   8545: ENDUPDATE
1.1035    www      8546: }
                   8547: 
1.1042    www      8548: sub LCprogressbarClose {
                   8549:     my ($r)=@_;
                   8550:     $LClastpercent=0;
1.1044    www      8551:     &r_print($r,<<ENDCLOSE);
1.1042    www      8552: <script type="text/javascript">
                   8553: // <![CDATA[
1.1045    www      8554: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8555: // ]]>
                   8556: </script>
                   8557: ENDCLOSE
1.1044    www      8558: }
                   8559: 
                   8560: sub r_print {
                   8561:     my ($r,$to_print)=@_;
                   8562:     if ($r) {
                   8563:       $r->print($to_print);
                   8564:       $r->rflush();
                   8565:     } else {
                   8566:       print($to_print);
                   8567:     }
1.1042    www      8568: }
                   8569: 
1.320     albertel 8570: sub html_encode {
                   8571:     my ($result) = @_;
                   8572: 
1.322     albertel 8573:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8574:     
                   8575:     return $result;
                   8576: }
1.1044    www      8577: 
1.317     albertel 8578: sub js_ready {
                   8579:     my ($result) = @_;
                   8580: 
1.323     albertel 8581:     $result =~ s/[\n\r]/ /xmsg;
                   8582:     $result =~ s/\\/\\\\/xmsg;
                   8583:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8584:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8585:     
                   8586:     return $result;
                   8587: }
                   8588: 
1.315     albertel 8589: sub validate_page {
                   8590:     if (  exists($env{'internal.start_page'})
1.316     albertel 8591: 	  &&     $env{'internal.start_page'} > 1) {
                   8592: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8593: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8594: 				 $ENV{'request.filename'});
1.315     albertel 8595:     }
                   8596:     if (  exists($env{'internal.end_page'})
1.316     albertel 8597: 	  &&     $env{'internal.end_page'} > 1) {
                   8598: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8599: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8600: 				 $env{'request.filename'});
1.315     albertel 8601:     }
                   8602:     if (     exists($env{'internal.start_page'})
                   8603: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8604: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8605: 				 $env{'request.filename'});
1.315     albertel 8606:     }
                   8607:     if (   ! exists($env{'internal.start_page'})
                   8608: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8609: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8610: 				 $env{'request.filename'});
1.315     albertel 8611:     }
1.306     albertel 8612: }
1.315     albertel 8613: 
1.996     www      8614: 
                   8615: sub start_scrollbox {
1.1140    raeburn  8616:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8617:     unless ($outerwidth) { $outerwidth='520px'; }
                   8618:     unless ($width) { $width='500px'; }
                   8619:     unless ($height) { $height='200px'; }
1.1075    raeburn  8620:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8621:     if ($id ne '') {
1.1140    raeburn  8622:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  8623:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8624:     }
1.1075    raeburn  8625:     if ($bgcolor ne '') {
                   8626:         $tdcol = "background-color: $bgcolor;";
                   8627:     }
1.1137    raeburn  8628:     my $nicescroll_js;
                   8629:     if ($env{'browser.mobile'}) {
1.1140    raeburn  8630:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8631:     }
                   8632:     return <<"END";
                   8633: $nicescroll_js
                   8634: 
                   8635: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   8636: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   8637: END
                   8638: }
                   8639: 
                   8640: sub end_scrollbox {
                   8641:     return '</div></td></tr></table>';
                   8642: }
                   8643: 
                   8644: sub nicescroll_javascript {
                   8645:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8646:     my %options;
                   8647:     if (ref($cursor) eq 'HASH') {
                   8648:         %options = %{$cursor};
                   8649:     }
                   8650:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8651:         $options{'railalign'} = 'left';
                   8652:     }
                   8653:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8654:         my $function  = &get_users_function();
                   8655:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  8656:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  8657:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  8658:         }
1.1140    raeburn  8659:     }
                   8660:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8661:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  8662:             $options{'cursoropacity'}='1.0';
                   8663:         }
1.1140    raeburn  8664:     } else {
                   8665:         $options{'cursoropacity'}='1.0';
                   8666:     }
                   8667:     if ($options{'cursorfixedheight'} eq 'none') {
                   8668:         delete($options{'cursorfixedheight'});
                   8669:     } else {
                   8670:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8671:     }
                   8672:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8673:         delete($options{'railoffset'});
                   8674:     }
                   8675:     my @niceoptions;
                   8676:     while (my($key,$value) = each(%options)) {
                   8677:         if ($value =~ /^\{.+\}$/) {
                   8678:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8679:         } else {
1.1140    raeburn  8680:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8681:         }
1.1140    raeburn  8682:     }
                   8683:     my $nicescroll_js = '
1.1137    raeburn  8684: $(document).ready(
1.1140    raeburn  8685:       function() {
                   8686:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8687:       }
1.1137    raeburn  8688: );
                   8689: ';
1.1140    raeburn  8690:     if ($framecheck) {
                   8691:         $nicescroll_js .= '
                   8692: function expand_div(caller) {
                   8693:     if (top === self) {
                   8694:         document.getElementById("'.$id.'").style.width = "auto";
                   8695:         document.getElementById("'.$id.'").style.height = "auto";
                   8696:     } else {
                   8697:         try {
                   8698:             if (parent.frames) {
                   8699:                 if (parent.frames.length > 1) {
                   8700:                     var framesrc = parent.frames[1].location.href;
                   8701:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8702:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8703:                         document.getElementById("'.$id.'").style.width = "auto";
                   8704:                         document.getElementById("'.$id.'").style.height = "auto";
                   8705:                     }
                   8706:                 }
                   8707:             }
                   8708:         } catch (e) {
                   8709:             return;
                   8710:         }
1.1137    raeburn  8711:     }
1.1140    raeburn  8712:     return;
1.996     www      8713: }
1.1140    raeburn  8714: ';
                   8715:     }
                   8716:     if ($needjsready) {
                   8717:         $nicescroll_js = '
                   8718: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8719:     } else {
                   8720:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8721:     }
                   8722:     return $nicescroll_js;
1.996     www      8723: }
                   8724: 
1.318     albertel 8725: sub simple_error_page {
1.1150    bisitz   8726:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  8727:     if (ref($args) eq 'HASH') {
                   8728:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8729:     } else {
                   8730:         $msg = &mt($msg);
                   8731:     }
1.1150    bisitz   8732: 
1.318     albertel 8733:     my $page =
                   8734: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   8735: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8736: 	&Apache::loncommon::end_page();
                   8737:     if (ref($r)) {
                   8738: 	$r->print($page);
1.327     albertel 8739: 	return;
1.318     albertel 8740:     }
                   8741:     return $page;
                   8742: }
1.347     albertel 8743: 
                   8744: {
1.610     albertel 8745:     my @row_count;
1.961     onken    8746: 
                   8747:     sub start_data_table_count {
                   8748:         unshift(@row_count, 0);
                   8749:         return;
                   8750:     }
                   8751: 
                   8752:     sub end_data_table_count {
                   8753:         shift(@row_count);
                   8754:         return;
                   8755:     }
                   8756: 
1.347     albertel 8757:     sub start_data_table {
1.1018    raeburn  8758: 	my ($add_class,$id) = @_;
1.422     albertel 8759: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8760:         my $table_id;
                   8761:         if (defined($id)) {
                   8762:             $table_id = ' id="'.$id.'"';
                   8763:         }
1.961     onken    8764: 	&start_data_table_count();
1.1018    raeburn  8765: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8766:     }
                   8767: 
                   8768:     sub end_data_table {
1.961     onken    8769: 	&end_data_table_count();
1.389     albertel 8770: 	return '</table>'."\n";;
1.347     albertel 8771:     }
                   8772: 
                   8773:     sub start_data_table_row {
1.974     wenzelju 8774: 	my ($add_class, $id) = @_;
1.610     albertel 8775: 	$row_count[0]++;
                   8776: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8777: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8778:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8779:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8780:     }
1.471     banghart 8781:     
                   8782:     sub continue_data_table_row {
1.974     wenzelju 8783: 	my ($add_class, $id) = @_;
1.610     albertel 8784: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8785: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8786:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8787:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8788:     }
1.347     albertel 8789: 
                   8790:     sub end_data_table_row {
1.389     albertel 8791: 	return '</tr>'."\n";;
1.347     albertel 8792:     }
1.367     www      8793: 
1.421     albertel 8794:     sub start_data_table_empty_row {
1.707     bisitz   8795: #	$row_count[0]++;
1.421     albertel 8796: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8797:     }
                   8798: 
                   8799:     sub end_data_table_empty_row {
                   8800: 	return '</tr>'."\n";;
                   8801:     }
                   8802: 
1.367     www      8803:     sub start_data_table_header_row {
1.389     albertel 8804: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8805:     }
                   8806: 
                   8807:     sub end_data_table_header_row {
1.389     albertel 8808: 	return '</tr>'."\n";;
1.367     www      8809:     }
1.890     droeschl 8810: 
                   8811:     sub data_table_caption {
                   8812:         my $caption = shift;
                   8813:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8814:     }
1.347     albertel 8815: }
                   8816: 
1.548     albertel 8817: =pod
                   8818: 
                   8819: =item * &inhibit_menu_check($arg)
                   8820: 
                   8821: Checks for a inhibitmenu state and generates output to preserve it
                   8822: 
                   8823: Inputs:         $arg - can be any of
                   8824:                      - undef - in which case the return value is a string 
                   8825:                                to add  into arguments list of a uri
                   8826:                      - 'input' - in which case the return value is a HTML
                   8827:                                  <form> <input> field of type hidden to
                   8828:                                  preserve the value
                   8829:                      - a url - in which case the return value is the url with
                   8830:                                the neccesary cgi args added to preserve the
                   8831:                                inhibitmenu state
                   8832:                      - a ref to a url - no return value, but the string is
                   8833:                                         updated to include the neccessary cgi
                   8834:                                         args to preserve the inhibitmenu state
                   8835: 
                   8836: =cut
                   8837: 
                   8838: sub inhibit_menu_check {
                   8839:     my ($arg) = @_;
                   8840:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8841:     if ($arg eq 'input') {
                   8842: 	if ($env{'form.inhibitmenu'}) {
                   8843: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8844: 	} else {
                   8845: 	    return
                   8846: 	}
                   8847:     }
                   8848:     if ($env{'form.inhibitmenu'}) {
                   8849: 	if (ref($arg)) {
                   8850: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8851: 	} elsif ($arg eq '') {
                   8852: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8853: 	} else {
                   8854: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8855: 	}
                   8856:     }
                   8857:     if (!ref($arg)) {
                   8858: 	return $arg;
                   8859:     }
                   8860: }
                   8861: 
1.251     albertel 8862: ###############################################
1.182     matthew  8863: 
                   8864: =pod
                   8865: 
1.549     albertel 8866: =back
                   8867: 
                   8868: =head1 User Information Routines
                   8869: 
                   8870: =over 4
                   8871: 
1.405     albertel 8872: =item * &get_users_function()
1.182     matthew  8873: 
                   8874: Used by &bodytag to determine the current users primary role.
                   8875: Returns either 'student','coordinator','admin', or 'author'.
                   8876: 
                   8877: =cut
                   8878: 
                   8879: ###############################################
                   8880: sub get_users_function {
1.815     tempelho 8881:     my $function = 'norole';
1.818     tempelho 8882:     if ($env{'request.role'}=~/^(st)/) {
                   8883:         $function='student';
                   8884:     }
1.907     raeburn  8885:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8886:         $function='coordinator';
                   8887:     }
1.258     albertel 8888:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8889:         $function='admin';
                   8890:     }
1.826     bisitz   8891:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8892:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8893:         $function='author';
                   8894:     }
                   8895:     return $function;
1.54      www      8896: }
1.99      www      8897: 
                   8898: ###############################################
                   8899: 
1.233     raeburn  8900: =pod
                   8901: 
1.821     raeburn  8902: =item * &show_course()
                   8903: 
                   8904: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8905: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8906: 
                   8907: Inputs:
                   8908: None
                   8909: 
                   8910: Outputs:
                   8911: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8912: 
                   8913: =cut
                   8914: 
                   8915: ###############################################
                   8916: sub show_course {
                   8917:     my $course = !$env{'user.adv'};
                   8918:     if (!$env{'user.adv'}) {
                   8919:         foreach my $env (keys(%env)) {
                   8920:             next if ($env !~ m/^user\.priv\./);
                   8921:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8922:                 $course = 0;
                   8923:                 last;
                   8924:             }
                   8925:         }
                   8926:     }
                   8927:     return $course;
                   8928: }
                   8929: 
                   8930: ###############################################
                   8931: 
                   8932: =pod
                   8933: 
1.542     raeburn  8934: =item * &check_user_status()
1.274     raeburn  8935: 
                   8936: Determines current status of supplied role for a
                   8937: specific user. Roles can be active, previous or future.
                   8938: 
                   8939: Inputs: 
                   8940: user's domain, user's username, course's domain,
1.375     raeburn  8941: course's number, optional section ID.
1.274     raeburn  8942: 
                   8943: Outputs:
                   8944: role status: active, previous or future. 
                   8945: 
                   8946: =cut
                   8947: 
                   8948: sub check_user_status {
1.412     raeburn  8949:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8950:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202    raeburn  8951:     my @uroles = keys(%userinfo);
1.274     raeburn  8952:     my $srchstr;
                   8953:     my $active_chk = 'none';
1.412     raeburn  8954:     my $now = time;
1.274     raeburn  8955:     if (@uroles > 0) {
1.908     raeburn  8956:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8957:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8958:         } else {
1.412     raeburn  8959:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8960:         }
                   8961:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8962:             my $role_end = 0;
                   8963:             my $role_start = 0;
                   8964:             $active_chk = 'active';
1.412     raeburn  8965:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8966:                 $role_end = $1;
                   8967:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8968:                     $role_start = $1;
1.274     raeburn  8969:                 }
                   8970:             }
                   8971:             if ($role_start > 0) {
1.412     raeburn  8972:                 if ($now < $role_start) {
1.274     raeburn  8973:                     $active_chk = 'future';
                   8974:                 }
                   8975:             }
                   8976:             if ($role_end > 0) {
1.412     raeburn  8977:                 if ($now > $role_end) {
1.274     raeburn  8978:                     $active_chk = 'previous';
                   8979:                 }
                   8980:             }
                   8981:         }
                   8982:     }
                   8983:     return $active_chk;
                   8984: }
                   8985: 
                   8986: ###############################################
                   8987: 
                   8988: =pod
                   8989: 
1.405     albertel 8990: =item * &get_sections()
1.233     raeburn  8991: 
                   8992: Determines all the sections for a course including
                   8993: sections with students and sections containing other roles.
1.419     raeburn  8994: Incoming parameters: 
                   8995: 
                   8996: 1. domain
                   8997: 2. course number 
                   8998: 3. reference to array containing roles for which sections should 
                   8999: be gathered (optional).
                   9000: 4. reference to array containing status types for which sections 
                   9001: should be gathered (optional).
                   9002: 
                   9003: If the third argument is undefined, sections are gathered for any role. 
                   9004: If the fourth argument is undefined, sections are gathered for any status.
                   9005: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  9006:  
1.374     raeburn  9007: Returns section hash (keys are section IDs, values are
                   9008: number of users in each section), subject to the
1.419     raeburn  9009: optional roles filter, optional status filter 
1.233     raeburn  9010: 
                   9011: =cut
                   9012: 
                   9013: ###############################################
                   9014: sub get_sections {
1.419     raeburn  9015:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 9016:     if (!defined($cdom) || !defined($cnum)) {
                   9017:         my $cid =  $env{'request.course.id'};
                   9018: 
                   9019: 	return if (!defined($cid));
                   9020: 
                   9021:         $cdom = $env{'course.'.$cid.'.domain'};
                   9022:         $cnum = $env{'course.'.$cid.'.num'};
                   9023:     }
                   9024: 
                   9025:     my %sectioncount;
1.419     raeburn  9026:     my $now = time;
1.240     albertel 9027: 
1.1118    raeburn  9028:     my $check_students = 1;
                   9029:     my $only_students = 0;
                   9030:     if (ref($possible_roles) eq 'ARRAY') {
                   9031:         if (grep(/^st$/,@{$possible_roles})) {
                   9032:             if (@{$possible_roles} == 1) {
                   9033:                 $only_students = 1;
                   9034:             }
                   9035:         } else {
                   9036:             $check_students = 0;
                   9037:         }
                   9038:     }
                   9039: 
                   9040:     if ($check_students) { 
1.276     albertel 9041: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 9042: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   9043: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  9044:         my $start_index = &Apache::loncoursedata::CL_START();
                   9045:         my $end_index = &Apache::loncoursedata::CL_END();
                   9046:         my $status;
1.366     albertel 9047: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  9048: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   9049: 				                     $data->[$status_index],
                   9050:                                                      $data->[$start_index],
                   9051:                                                      $data->[$end_index]);
                   9052:             if ($stu_status eq 'Active') {
                   9053:                 $status = 'active';
                   9054:             } elsif ($end < $now) {
                   9055:                 $status = 'previous';
                   9056:             } elsif ($start > $now) {
                   9057:                 $status = 'future';
                   9058:             } 
                   9059: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   9060:                 if ((!defined($possible_status)) || (($status ne '') && 
                   9061:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   9062: 		    $sectioncount{$section}++;
                   9063:                 }
1.240     albertel 9064: 	    }
                   9065: 	}
                   9066:     }
1.1118    raeburn  9067:     if ($only_students) {
                   9068:         return %sectioncount;
                   9069:     }
1.240     albertel 9070:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9071:     foreach my $user (sort(keys(%courseroles))) {
                   9072: 	if ($user !~ /^(\w{2})/) { next; }
                   9073: 	my ($role) = ($user =~ /^(\w{2})/);
                   9074: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  9075: 	my ($section,$status);
1.240     albertel 9076: 	if ($role eq 'cr' &&
                   9077: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   9078: 	    $section=$1;
                   9079: 	}
                   9080: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   9081: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  9082:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   9083:         if ($end == -1 && $start == -1) {
                   9084:             next; #deleted role
                   9085:         }
                   9086:         if (!defined($possible_status)) { 
                   9087:             $sectioncount{$section}++;
                   9088:         } else {
                   9089:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   9090:                 $status = 'active';
                   9091:             } elsif ($end < $now) {
                   9092:                 $status = 'future';
                   9093:             } elsif ($start > $now) {
                   9094:                 $status = 'previous';
                   9095:             }
                   9096:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   9097:                 $sectioncount{$section}++;
                   9098:             }
                   9099:         }
1.233     raeburn  9100:     }
1.366     albertel 9101:     return %sectioncount;
1.233     raeburn  9102: }
                   9103: 
1.274     raeburn  9104: ###############################################
1.294     raeburn  9105: 
                   9106: =pod
1.405     albertel 9107: 
                   9108: =item * &get_course_users()
                   9109: 
1.275     raeburn  9110: Retrieves usernames:domains for users in the specified course
                   9111: with specific role(s), and access status. 
                   9112: 
                   9113: Incoming parameters:
1.277     albertel 9114: 1. course domain
                   9115: 2. course number
                   9116: 3. access status: users must have - either active, 
1.275     raeburn  9117: previous, future, or all.
1.277     albertel 9118: 4. reference to array of permissible roles
1.288     raeburn  9119: 5. reference to array of section restrictions (optional)
                   9120: 6. reference to results object (hash of hashes).
                   9121: 7. reference to optional userdata hash
1.609     raeburn  9122: 8. reference to optional statushash
1.630     raeburn  9123: 9. flag if privileged users (except those set to unhide in
                   9124:    course settings) should be excluded    
1.609     raeburn  9125: Keys of top level results hash are roles.
1.275     raeburn  9126: Keys of inner hashes are username:domain, with 
                   9127: values set to access type.
1.288     raeburn  9128: Optional userdata hash returns an array with arguments in the 
                   9129: same order as loncoursedata::get_classlist() for student data.
                   9130: 
1.609     raeburn  9131: Optional statushash returns
                   9132: 
1.288     raeburn  9133: Entries for end, start, section and status are blank because
                   9134: of the possibility of multiple values for non-student roles.
                   9135: 
1.275     raeburn  9136: =cut
1.405     albertel 9137: 
1.275     raeburn  9138: ###############################################
1.405     albertel 9139: 
1.275     raeburn  9140: sub get_course_users {
1.630     raeburn  9141:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  9142:     my %idx = ();
1.419     raeburn  9143:     my %seclists;
1.288     raeburn  9144: 
                   9145:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   9146:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   9147:     $idx{end} = &Apache::loncoursedata::CL_END();
                   9148:     $idx{start} = &Apache::loncoursedata::CL_START();
                   9149:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   9150:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   9151:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   9152:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   9153: 
1.290     albertel 9154:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 9155:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  9156:         my $now = time;
1.277     albertel 9157:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  9158:             my $match = 0;
1.412     raeburn  9159:             my $secmatch = 0;
1.419     raeburn  9160:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  9161:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  9162:             if ($section eq '') {
                   9163:                 $section = 'none';
                   9164:             }
1.291     albertel 9165:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9166:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9167:                     $secmatch = 1;
                   9168:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 9169:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9170:                         $secmatch = 1;
                   9171:                     }
                   9172:                 } else {  
1.419     raeburn  9173: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  9174: 		        $secmatch = 1;
                   9175:                     }
1.290     albertel 9176: 		}
1.412     raeburn  9177:                 if (!$secmatch) {
                   9178:                     next;
                   9179:                 }
1.419     raeburn  9180:             }
1.275     raeburn  9181:             if (defined($$types{'active'})) {
1.288     raeburn  9182:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  9183:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  9184:                     $match = 1;
1.275     raeburn  9185:                 }
                   9186:             }
                   9187:             if (defined($$types{'previous'})) {
1.609     raeburn  9188:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  9189:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  9190:                     $match = 1;
1.275     raeburn  9191:                 }
                   9192:             }
                   9193:             if (defined($$types{'future'})) {
1.609     raeburn  9194:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  9195:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  9196:                     $match = 1;
1.275     raeburn  9197:                 }
                   9198:             }
1.609     raeburn  9199:             if ($match) {
                   9200:                 push(@{$seclists{$student}},$section);
                   9201:                 if (ref($userdata) eq 'HASH') {
                   9202:                     $$userdata{$student} = $$classlist{$student};
                   9203:                 }
                   9204:                 if (ref($statushash) eq 'HASH') {
                   9205:                     $statushash->{$student}{'st'}{$section} = $status;
                   9206:                 }
1.288     raeburn  9207:             }
1.275     raeburn  9208:         }
                   9209:     }
1.412     raeburn  9210:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  9211:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9212:         my $now = time;
1.609     raeburn  9213:         my %displaystatus = ( previous => 'Expired',
                   9214:                               active   => 'Active',
                   9215:                               future   => 'Future',
                   9216:                             );
1.1121    raeburn  9217:         my (%nothide,@possdoms);
1.630     raeburn  9218:         if ($hidepriv) {
                   9219:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   9220:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   9221:                 if ($user !~ /:/) {
                   9222:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   9223:                 } else {
                   9224:                     $nothide{$user} = 1;
                   9225:                 }
                   9226:             }
1.1121    raeburn  9227:             my @possdoms = ($cdom);
                   9228:             if ($coursehash{'checkforpriv'}) {
                   9229:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   9230:             }
1.630     raeburn  9231:         }
1.439     raeburn  9232:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  9233:             my $match = 0;
1.412     raeburn  9234:             my $secmatch = 0;
1.439     raeburn  9235:             my $status;
1.412     raeburn  9236:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  9237:             $user =~ s/:$//;
1.439     raeburn  9238:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   9239:             if ($end == -1 || $start == -1) {
                   9240:                 next;
                   9241:             }
                   9242:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   9243:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  9244:                 my ($uname,$udom) = split(/:/,$user);
                   9245:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9246:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9247:                         $secmatch = 1;
                   9248:                     } elsif ($usec eq '') {
1.420     albertel 9249:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9250:                             $secmatch = 1;
                   9251:                         }
                   9252:                     } else {
                   9253:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   9254:                             $secmatch = 1;
                   9255:                         }
                   9256:                     }
                   9257:                     if (!$secmatch) {
                   9258:                         next;
                   9259:                     }
1.288     raeburn  9260:                 }
1.419     raeburn  9261:                 if ($usec eq '') {
                   9262:                     $usec = 'none';
                   9263:                 }
1.275     raeburn  9264:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  9265:                     if ($hidepriv) {
1.1121    raeburn  9266:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  9267:                             (!$nothide{$uname.':'.$udom})) {
                   9268:                             next;
                   9269:                         }
                   9270:                     }
1.503     raeburn  9271:                     if ($end > 0 && $end < $now) {
1.439     raeburn  9272:                         $status = 'previous';
                   9273:                     } elsif ($start > $now) {
                   9274:                         $status = 'future';
                   9275:                     } else {
                   9276:                         $status = 'active';
                   9277:                     }
1.277     albertel 9278:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  9279:                         if ($status eq $type) {
1.420     albertel 9280:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  9281:                                 push(@{$$users{$role}{$user}},$type);
                   9282:                             }
1.288     raeburn  9283:                             $match = 1;
                   9284:                         }
                   9285:                     }
1.419     raeburn  9286:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   9287:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   9288: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   9289:                         }
1.420     albertel 9290:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  9291:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   9292:                         }
1.609     raeburn  9293:                         if (ref($statushash) eq 'HASH') {
                   9294:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   9295:                         }
1.275     raeburn  9296:                     }
                   9297:                 }
                   9298:             }
                   9299:         }
1.290     albertel 9300:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  9301:             if ((defined($cdom)) && (defined($cnum))) {
                   9302:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   9303:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   9304:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  9305:                     next if ($owner eq '');
                   9306:                     my ($ownername,$ownerdom);
                   9307:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   9308:                         $ownername = $1;
                   9309:                         $ownerdom = $2;
                   9310:                     } else {
                   9311:                         $ownername = $owner;
                   9312:                         $ownerdom = $cdom;
                   9313:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  9314:                     }
                   9315:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 9316:                     if (defined($userdata) && 
1.609     raeburn  9317: 			!exists($$userdata{$owner})) {
                   9318: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   9319:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   9320:                             push(@{$seclists{$owner}},'none');
                   9321:                         }
                   9322:                         if (ref($statushash) eq 'HASH') {
                   9323:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  9324:                         }
1.290     albertel 9325: 		    }
1.279     raeburn  9326:                 }
                   9327:             }
                   9328:         }
1.419     raeburn  9329:         foreach my $user (keys(%seclists)) {
                   9330:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   9331:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   9332:         }
1.275     raeburn  9333:     }
                   9334:     return;
                   9335: }
                   9336: 
1.288     raeburn  9337: sub get_user_info {
                   9338:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 9339:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   9340: 	&plainname($uname,$udom,'lastname');
1.291     albertel 9341:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  9342:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  9343:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   9344:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  9345:     return;
                   9346: }
1.275     raeburn  9347: 
1.472     raeburn  9348: ###############################################
                   9349: 
                   9350: =pod
                   9351: 
                   9352: =item * &get_user_quota()
                   9353: 
1.1134    raeburn  9354: Retrieves quota assigned for storage of user files.
                   9355: Default is to report quota for portfolio files.
1.472     raeburn  9356: 
                   9357: Incoming parameters:
                   9358: 1. user's username
                   9359: 2. user's domain
1.1134    raeburn  9360: 3. quota name - portfolio, author, or course
1.1136    raeburn  9361:    (if no quota name provided, defaults to portfolio).
1.1237    raeburn  9362: 4. crstype - official, unofficial, textbook, placement or community, 
                   9363:    if quota name is course
1.472     raeburn  9364: 
                   9365: Returns:
1.1163    raeburn  9366: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  9367: 2. (Optional) Type of setting: custom or default
                   9368:    (individually assigned or default for user's 
                   9369:    institutional status).
                   9370: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   9371:    or student - types as defined in localenroll::inst_usertypes 
                   9372:    for user's domain, which determines default quota for user.
                   9373: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  9374: 
                   9375: If a value has been stored in the user's environment, 
1.536     raeburn  9376: it will return that, otherwise it returns the maximal default
1.1134    raeburn  9377: defined for the user's institutional status(es) in the domain.
1.472     raeburn  9378: 
                   9379: =cut
                   9380: 
                   9381: ###############################################
                   9382: 
                   9383: 
                   9384: sub get_user_quota {
1.1136    raeburn  9385:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  9386:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  9387:     if (!defined($udom)) {
                   9388:         $udom = $env{'user.domain'};
                   9389:     }
                   9390:     if (!defined($uname)) {
                   9391:         $uname = $env{'user.name'};
                   9392:     }
                   9393:     if (($udom eq '' || $uname eq '') ||
                   9394:         ($udom eq 'public') && ($uname eq 'public')) {
                   9395:         $quota = 0;
1.536     raeburn  9396:         $quotatype = 'default';
                   9397:         $defquota = 0; 
1.472     raeburn  9398:     } else {
1.536     raeburn  9399:         my $inststatus;
1.1134    raeburn  9400:         if ($quotaname eq 'course') {
                   9401:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   9402:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   9403:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   9404:             } else {
                   9405:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   9406:                 $quota = $cenv{'internal.uploadquota'};
                   9407:             }
1.536     raeburn  9408:         } else {
1.1134    raeburn  9409:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   9410:                 if ($quotaname eq 'author') {
                   9411:                     $quota = $env{'environment.authorquota'};
                   9412:                 } else {
                   9413:                     $quota = $env{'environment.portfolioquota'};
                   9414:                 }
                   9415:                 $inststatus = $env{'environment.inststatus'};
                   9416:             } else {
                   9417:                 my %userenv = 
                   9418:                     &Apache::lonnet::get('environment',['portfolioquota',
                   9419:                                          'authorquota','inststatus'],$udom,$uname);
                   9420:                 my ($tmp) = keys(%userenv);
                   9421:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9422:                     if ($quotaname eq 'author') {
                   9423:                         $quota = $userenv{'authorquota'};
                   9424:                     } else {
                   9425:                         $quota = $userenv{'portfolioquota'};
                   9426:                     }
                   9427:                     $inststatus = $userenv{'inststatus'};
                   9428:                 } else {
                   9429:                     undef(%userenv);
                   9430:                 }
                   9431:             }
                   9432:         }
                   9433:         if ($quota eq '' || wantarray) {
                   9434:             if ($quotaname eq 'course') {
                   9435:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  9436:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
1.1237    raeburn  9437:                     ($crstype eq 'community') || ($crstype eq 'textbook') ||
                   9438:                     ($crstype eq 'placement')) { 
1.1136    raeburn  9439:                     $defquota = $domdefs{$crstype.'quota'};
                   9440:                 }
                   9441:                 if ($defquota eq '') {
                   9442:                     $defquota = 500;
                   9443:                 }
1.1134    raeburn  9444:             } else {
                   9445:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   9446:             }
                   9447:             if ($quota eq '') {
                   9448:                 $quota = $defquota;
                   9449:                 $quotatype = 'default';
                   9450:             } else {
                   9451:                 $quotatype = 'custom';
                   9452:             }
1.472     raeburn  9453:         }
                   9454:     }
1.536     raeburn  9455:     if (wantarray) {
                   9456:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9457:     } else {
                   9458:         return $quota;
                   9459:     }
1.472     raeburn  9460: }
                   9461: 
                   9462: ###############################################
                   9463: 
                   9464: =pod
                   9465: 
                   9466: =item * &default_quota()
                   9467: 
1.536     raeburn  9468: Retrieves default quota assigned for storage of user portfolio files,
                   9469: given an (optional) user's institutional status.
1.472     raeburn  9470: 
                   9471: Incoming parameters:
1.1142    raeburn  9472: 
1.472     raeburn  9473: 1. domain
1.536     raeburn  9474: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9475:    status types (e.g., faculty, staff, student etc.)
                   9476:    which apply to the user for whom the default is being retrieved.
                   9477:    If the institutional status string in undefined, the domain
1.1134    raeburn  9478:    default quota will be returned.
                   9479: 3.  quota name - portfolio, author, or course
                   9480:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9481: 
                   9482: Returns:
1.1142    raeburn  9483: 
1.1163    raeburn  9484: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9485: 2. (Optional) institutional type which determined the value of the
                   9486:    default quota.
1.472     raeburn  9487: 
                   9488: If a value has been stored in the domain's configuration db,
                   9489: it will return that, otherwise it returns 20 (for backwards 
                   9490: compatibility with domains which have not set up a configuration
1.1163    raeburn  9491: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9492: 
1.536     raeburn  9493: If the user's status includes multiple types (e.g., staff and student),
                   9494: the largest default quota which applies to the user determines the
                   9495: default quota returned.
                   9496: 
1.472     raeburn  9497: =cut
                   9498: 
                   9499: ###############################################
                   9500: 
                   9501: 
                   9502: sub default_quota {
1.1134    raeburn  9503:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9504:     my ($defquota,$settingstatus);
                   9505:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9506:                                             ['quotas'],$udom);
1.1134    raeburn  9507:     my $key = 'defaultquota';
                   9508:     if ($quotaname eq 'author') {
                   9509:         $key = 'authorquota';
                   9510:     }
1.622     raeburn  9511:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9512:         if ($inststatus ne '') {
1.765     raeburn  9513:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9514:             foreach my $item (@statuses) {
1.1134    raeburn  9515:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9516:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9517:                         if ($defquota eq '') {
1.1134    raeburn  9518:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9519:                             $settingstatus = $item;
1.1134    raeburn  9520:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9521:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9522:                             $settingstatus = $item;
                   9523:                         }
                   9524:                     }
1.1134    raeburn  9525:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9526:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9527:                         if ($defquota eq '') {
                   9528:                             $defquota = $quotahash{'quotas'}{$item};
                   9529:                             $settingstatus = $item;
                   9530:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9531:                             $defquota = $quotahash{'quotas'}{$item};
                   9532:                             $settingstatus = $item;
                   9533:                         }
1.536     raeburn  9534:                     }
                   9535:                 }
                   9536:             }
                   9537:         }
                   9538:         if ($defquota eq '') {
1.1134    raeburn  9539:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9540:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9541:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9542:                 $defquota = $quotahash{'quotas'}{'default'};
                   9543:             }
1.536     raeburn  9544:             $settingstatus = 'default';
1.1139    raeburn  9545:             if ($defquota eq '') {
                   9546:                 if ($quotaname eq 'author') {
                   9547:                     $defquota = 500;
                   9548:                 }
                   9549:             }
1.536     raeburn  9550:         }
                   9551:     } else {
                   9552:         $settingstatus = 'default';
1.1134    raeburn  9553:         if ($quotaname eq 'author') {
                   9554:             $defquota = 500;
                   9555:         } else {
                   9556:             $defquota = 20;
                   9557:         }
1.536     raeburn  9558:     }
                   9559:     if (wantarray) {
                   9560:         return ($defquota,$settingstatus);
1.472     raeburn  9561:     } else {
1.536     raeburn  9562:         return $defquota;
1.472     raeburn  9563:     }
                   9564: }
                   9565: 
1.1135    raeburn  9566: ###############################################
                   9567: 
                   9568: =pod
                   9569: 
1.1136    raeburn  9570: =item * &excess_filesize_warning()
1.1135    raeburn  9571: 
                   9572: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  9573: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  9574: space to be exceeded.
1.1136    raeburn  9575: 
                   9576: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  9577: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  9578: 
1.1165    raeburn  9579: Inputs: 7 
1.1136    raeburn  9580: 1. username or coursenum
1.1135    raeburn  9581: 2. domain
1.1136    raeburn  9582: 3. context ('author' or 'course')
1.1135    raeburn  9583: 4. filename of file for which action is being requested
                   9584: 5. filesize (kB) of file
                   9585: 6. action being taken: copy or upload.
1.1237    raeburn  9586: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135    raeburn  9587: 
                   9588: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  9589:          otherwise return null.
                   9590: 
                   9591: =back
1.1135    raeburn  9592: 
                   9593: =cut
                   9594: 
1.1136    raeburn  9595: sub excess_filesize_warning {
1.1165    raeburn  9596:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  9597:     my $current_disk_usage = 0;
1.1165    raeburn  9598:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  9599:     if ($context eq 'author') {
                   9600:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9601:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9602:     } else {
                   9603:         foreach my $subdir ('docs','supplemental') {
                   9604:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9605:         }
                   9606:     }
1.1135    raeburn  9607:     $disk_quota = int($disk_quota * 1000);
                   9608:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   9609:         return '<p class="LC_warning">'.
1.1135    raeburn  9610:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   9611:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9612:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  9613:                             $disk_quota,$current_disk_usage).
                   9614:                '</p>';
                   9615:     }
                   9616:     return;
                   9617: }
                   9618: 
                   9619: ###############################################
                   9620: 
                   9621: 
1.1136    raeburn  9622: 
                   9623: 
1.384     raeburn  9624: sub get_secgrprole_info {
                   9625:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9626:     my %sections_count = &get_sections($cdom,$cnum);
                   9627:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9628:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9629:     my @groups = sort(keys(%curr_groups));
                   9630:     my $allroles = [];
                   9631:     my $rolehash;
                   9632:     my $accesshash = {
                   9633:                      active => 'Currently has access',
                   9634:                      future => 'Will have future access',
                   9635:                      previous => 'Previously had access',
                   9636:                   };
                   9637:     if ($needroles) {
                   9638:         $rolehash = {'all' => 'all'};
1.385     albertel 9639:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9640: 	if (&Apache::lonnet::error(%user_roles)) {
                   9641: 	    undef(%user_roles);
                   9642: 	}
                   9643:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9644:             my ($role)=split(/\:/,$item,2);
                   9645:             if ($role eq 'cr') { next; }
                   9646:             if ($role =~ /^cr/) {
                   9647:                 $$rolehash{$role} = (split('/',$role))[3];
                   9648:             } else {
                   9649:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9650:             }
                   9651:         }
                   9652:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9653:             push(@{$allroles},$key);
                   9654:         }
                   9655:         push (@{$allroles},'st');
                   9656:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9657:     }
                   9658:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9659: }
                   9660: 
1.555     raeburn  9661: sub user_picker {
1.994     raeburn  9662:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9663:     my $currdom = $dom;
                   9664:     my %curr_selected = (
                   9665:                         srchin => 'dom',
1.580     raeburn  9666:                         srchby => 'lastname',
1.555     raeburn  9667:                       );
                   9668:     my $srchterm;
1.625     raeburn  9669:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9670:         if ($srch->{'srchby'} ne '') {
                   9671:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9672:         }
                   9673:         if ($srch->{'srchin'} ne '') {
                   9674:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9675:         }
                   9676:         if ($srch->{'srchtype'} ne '') {
                   9677:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9678:         }
                   9679:         if ($srch->{'srchdomain'} ne '') {
                   9680:             $currdom = $srch->{'srchdomain'};
                   9681:         }
                   9682:         $srchterm = $srch->{'srchterm'};
                   9683:     }
1.1222    damieng  9684:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  9685:                     'usr'       => 'Search criteria',
1.563     raeburn  9686:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9687:                     'uname'     => 'username',
                   9688:                     'lastname'  => 'last name',
1.555     raeburn  9689:                     'lastfirst' => 'last name, first name',
1.558     albertel 9690:                     'crs'       => 'in this course',
1.576     raeburn  9691:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9692:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9693:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9694:                     'exact'     => 'is',
                   9695:                     'contains'  => 'contains',
1.569     raeburn  9696:                     'begins'    => 'begins with',
1.1222    damieng  9697:                                        );
                   9698:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  9699:                     'youm'      => "You must include some text to search for.",
                   9700:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9701:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9702:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9703:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9704:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9705:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9706:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9707:                                        );
1.1222    damieng  9708:     &html_escape(\%html_lt);
                   9709:     &js_escape(\%js_lt);
1.563     raeburn  9710:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9711:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9712: 
                   9713:     my @srchins = ('crs','dom','alc','instd');
                   9714: 
                   9715:     foreach my $option (@srchins) {
                   9716:         # FIXME 'alc' option unavailable until 
                   9717:         #       loncreateuser::print_user_query_page()
                   9718:         #       has been completed.
                   9719:         next if ($option eq 'alc');
1.880     raeburn  9720:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9721:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9722:         if ($curr_selected{'srchin'} eq $option) {
                   9723:             $srchinsel .= ' 
1.1222    damieng  9724:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  9725:         } else {
                   9726:             $srchinsel .= '
1.1222    damieng  9727:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  9728:         }
1.555     raeburn  9729:     }
1.563     raeburn  9730:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9731: 
                   9732:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9733:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9734:         if ($curr_selected{'srchby'} eq $option) {
                   9735:             $srchbysel .= '
1.1222    damieng  9736:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9737:         } else {
                   9738:             $srchbysel .= '
1.1222    damieng  9739:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9740:          }
                   9741:     }
                   9742:     $srchbysel .= "\n  </select>\n";
                   9743: 
                   9744:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9745:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9746:         if ($curr_selected{'srchtype'} eq $option) {
                   9747:             $srchtypesel .= '
1.1222    damieng  9748:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9749:         } else {
                   9750:             $srchtypesel .= '
1.1222    damieng  9751:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9752:         }
                   9753:     }
                   9754:     $srchtypesel .= "\n  </select>\n";
                   9755: 
1.558     albertel 9756:     my ($newuserscript,$new_user_create);
1.994     raeburn  9757:     my $context_dom = $env{'request.role.domain'};
                   9758:     if ($context eq 'requestcrs') {
                   9759:         if ($env{'form.coursedom'} ne '') { 
                   9760:             $context_dom = $env{'form.coursedom'};
                   9761:         }
                   9762:     }
1.556     raeburn  9763:     if ($forcenewuser) {
1.576     raeburn  9764:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9765:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9766:                 if ($cancreate) {
                   9767:                     $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>';
                   9768:                 } else {
1.799     bisitz   9769:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9770:                     my %usertypetext = (
                   9771:                         official   => 'institutional',
                   9772:                         unofficial => 'non-institutional',
                   9773:                     );
1.799     bisitz   9774:                     $new_user_create = '<p class="LC_warning">'
                   9775:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9776:                                       .' '
                   9777:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9778:                                           ,'<a href="'.$helplink.'">','</a>')
                   9779:                                       .'</p><br />';
1.627     raeburn  9780:                 }
1.576     raeburn  9781:             }
                   9782:         }
                   9783: 
1.556     raeburn  9784:         $newuserscript = <<"ENDSCRIPT";
                   9785: 
1.570     raeburn  9786: function setSearch(createnew,callingForm) {
1.556     raeburn  9787:     if (createnew == 1) {
1.570     raeburn  9788:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9789:             if (callingForm.srchby.options[i].value == 'uname') {
                   9790:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9791:             }
                   9792:         }
1.570     raeburn  9793:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9794:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9795: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9796:             }
                   9797:         }
1.570     raeburn  9798:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9799:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9800:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9801:             }
                   9802:         }
1.570     raeburn  9803:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9804:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9805:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9806:             }
                   9807:         }
                   9808:     }
                   9809: }
                   9810: ENDSCRIPT
1.558     albertel 9811: 
1.556     raeburn  9812:     }
                   9813: 
1.555     raeburn  9814:     my $output = <<"END_BLOCK";
1.556     raeburn  9815: <script type="text/javascript">
1.824     bisitz   9816: // <![CDATA[
1.570     raeburn  9817: function validateEntry(callingForm) {
1.558     albertel 9818: 
1.556     raeburn  9819:     var checkok = 1;
1.558     albertel 9820:     var srchin;
1.570     raeburn  9821:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9822: 	if ( callingForm.srchin[i].checked ) {
                   9823: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9824: 	}
                   9825:     }
                   9826: 
1.570     raeburn  9827:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9828:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9829:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9830:     var srchterm =  callingForm.srchterm.value;
                   9831:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9832:     var msg = "";
                   9833: 
                   9834:     if (srchterm == "") {
                   9835:         checkok = 0;
1.1222    damieng  9836:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  9837:     }
                   9838: 
1.569     raeburn  9839:     if (srchtype== 'begins') {
                   9840:         if (srchterm.length < 2) {
                   9841:             checkok = 0;
1.1222    damieng  9842:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  9843:         }
                   9844:     }
                   9845: 
1.556     raeburn  9846:     if (srchtype== 'contains') {
                   9847:         if (srchterm.length < 3) {
                   9848:             checkok = 0;
1.1222    damieng  9849:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  9850:         }
                   9851:     }
                   9852:     if (srchin == 'instd') {
                   9853:         if (srchdomain == '') {
                   9854:             checkok = 0;
1.1222    damieng  9855:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  9856:         }
                   9857:     }
                   9858:     if (srchin == 'dom') {
                   9859:         if (srchdomain == '') {
                   9860:             checkok = 0;
1.1222    damieng  9861:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  9862:         }
                   9863:     }
                   9864:     if (srchby == 'lastfirst') {
                   9865:         if (srchterm.indexOf(",") == -1) {
                   9866:             checkok = 0;
1.1222    damieng  9867:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  9868:         }
                   9869:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9870:             checkok = 0;
1.1222    damieng  9871:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  9872:         }
                   9873:     }
                   9874:     if (checkok == 0) {
1.1222    damieng  9875:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  9876:         return;
                   9877:     }
                   9878:     if (checkok == 1) {
1.570     raeburn  9879:         callingForm.submit();
1.556     raeburn  9880:     }
                   9881: }
                   9882: 
                   9883: $newuserscript
                   9884: 
1.824     bisitz   9885: // ]]>
1.556     raeburn  9886: </script>
1.558     albertel 9887: 
                   9888: $new_user_create
                   9889: 
1.555     raeburn  9890: END_BLOCK
1.558     albertel 9891: 
1.876     raeburn  9892:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222    damieng  9893:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  9894:                $domform.
                   9895:                &Apache::lonhtmlcommon::row_closure().
1.1222    damieng  9896:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  9897:                $srchbysel.
                   9898:                $srchtypesel. 
                   9899:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9900:                $srchinsel.
                   9901:                &Apache::lonhtmlcommon::row_closure(1). 
                   9902:                &Apache::lonhtmlcommon::end_pick_box().
                   9903:                '<br />';
1.555     raeburn  9904:     return $output;
                   9905: }
                   9906: 
1.612     raeburn  9907: sub user_rule_check {
1.615     raeburn  9908:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226    raeburn  9909:     my ($response,%inst_response);
1.612     raeburn  9910:     if (ref($usershash) eq 'HASH') {
1.1226    raeburn  9911:         if (keys(%{$usershash}) > 1) {
                   9912:             my (%by_username,%by_id,%userdoms);
                   9913:             my $checkid; 
                   9914:             if (ref($checks) eq 'HASH') {
                   9915:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   9916:                     $checkid = 1;
                   9917:                 }
                   9918:             }
                   9919:             foreach my $user (keys(%{$usershash})) {
                   9920:                 my ($uname,$udom) = split(/:/,$user);
                   9921:                 if ($checkid) {
                   9922:                     if (ref($usershash->{$user}) eq 'HASH') {
                   9923:                         if ($usershash->{$user}->{'id'} ne '') {
1.1227    raeburn  9924:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
1.1226    raeburn  9925:                             $userdoms{$udom} = 1;
1.1227    raeburn  9926:                             if (ref($inst_results) eq 'HASH') {
                   9927:                                 $inst_results->{$uname.':'.$udom} = {};
                   9928:                             }
1.1226    raeburn  9929:                         }
                   9930:                     }
                   9931:                 } else {
                   9932:                     $by_username{$udom}{$uname} = 1;
                   9933:                     $userdoms{$udom} = 1;
1.1227    raeburn  9934:                     if (ref($inst_results) eq 'HASH') {
                   9935:                         $inst_results->{$uname.':'.$udom} = {};
                   9936:                     }
1.1226    raeburn  9937:                 }
                   9938:             }
                   9939:             foreach my $udom (keys(%userdoms)) {
                   9940:                 if (!$got_rules->{$udom}) {
                   9941:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9942:                                                              ['usercreation'],$udom);
                   9943:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   9944:                         foreach my $item ('username','id') {
                   9945:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227    raeburn  9946:                                 $$curr_rules{$udom}{$item} =
                   9947:                                     $domconfig{'usercreation'}{$item.'_rule'};
1.1226    raeburn  9948:                             }
                   9949:                         }
                   9950:                     }
                   9951:                     $got_rules->{$udom} = 1;
                   9952:                 }
1.612     raeburn  9953:             }
1.1226    raeburn  9954:             if ($checkid) {
                   9955:                 foreach my $udom (keys(%by_id)) {
                   9956:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   9957:                     if ($outcome eq 'ok') {
1.1227    raeburn  9958:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   9959:                             my $uname = $by_id{$udom}{$id};
                   9960:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9961:                         }
1.1226    raeburn  9962:                         if (ref($results) eq 'HASH') {
                   9963:                             foreach my $uname (keys(%{$results})) {
1.1227    raeburn  9964:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   9965:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   9966:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9967:                                 }
1.1226    raeburn  9968:                             }
                   9969:                         }
                   9970:                     }
1.612     raeburn  9971:                 }
1.615     raeburn  9972:             } else {
1.1226    raeburn  9973:                 foreach my $udom (keys(%by_username)) {
                   9974:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   9975:                     if ($outcome eq 'ok') {
1.1227    raeburn  9976:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   9977:                             $inst_response{$uname.':'.$udom} = $outcome;
                   9978:                         }
1.1226    raeburn  9979:                         if (ref($results) eq 'HASH') {
                   9980:                             foreach my $uname (keys(%{$results})) {
                   9981:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   9982:                             }
                   9983:                         }
                   9984:                     }
                   9985:                 }
1.612     raeburn  9986:             }
1.1226    raeburn  9987:         } elsif (keys(%{$usershash}) == 1) {
                   9988:             my $user = (keys(%{$usershash}))[0];
                   9989:             my ($uname,$udom) = split(/:/,$user);
                   9990:             if (($udom ne '') && ($uname ne '')) {
                   9991:                 if (ref($usershash->{$user}) eq 'HASH') {
                   9992:                     if (ref($checks) eq 'HASH') {
                   9993:                         if (defined($checks->{'username'})) {
                   9994:                             ($inst_response{$user},%{$inst_results->{$user}}) = 
                   9995:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   9996:                         } elsif (defined($checks->{'id'})) {
                   9997:                             if ($usershash->{$user}->{'id'} ne '') {
                   9998:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   9999:                                     &Apache::lonnet::get_instuser($udom,undef,
                   10000:                                                                   $usershash->{$user}->{'id'});
                   10001:                             } else {
                   10002:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10003:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   10004:                             }
1.585     raeburn  10005:                         }
1.1226    raeburn  10006:                     } else {
                   10007:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   10008:                             &Apache::lonnet::get_instuser($udom,$uname);
                   10009:                        return;
                   10010:                     }
                   10011:                     if (!$got_rules->{$udom}) {
                   10012:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10013:                                                                  ['usercreation'],$udom);
                   10014:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10015:                             foreach my $item ('username','id') {
                   10016:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10017:                                    $$curr_rules{$udom}{$item} = 
                   10018:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   10019:                                 }
                   10020:                             }
                   10021:                         }
                   10022:                         $got_rules->{$udom} = 1;
1.585     raeburn  10023:                     }
                   10024:                 }
1.1226    raeburn  10025:             } else {
                   10026:                 return;
                   10027:             }
                   10028:         } else {
                   10029:             return;
                   10030:         }
                   10031:         foreach my $user (keys(%{$usershash})) {
                   10032:             my ($uname,$udom) = split(/:/,$user);
                   10033:             next if (($udom eq '') || ($uname eq ''));
                   10034:             my $id;
1.1227    raeburn  10035:             if (ref($inst_results) eq 'HASH') {
                   10036:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   10037:                     $id = $inst_results->{$user}->{'id'};
                   10038:                 }
                   10039:             }
                   10040:             if ($id eq '') { 
                   10041:                 if (ref($usershash->{$user})) {
                   10042:                     $id = $usershash->{$user}->{'id'};
                   10043:                 }
1.585     raeburn  10044:             }
1.612     raeburn  10045:             foreach my $item (keys(%{$checks})) {
                   10046:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   10047:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   10048:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226    raeburn  10049:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   10050:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  10051:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   10052:                                 if ($rule_check{$rule}) {
                   10053:                                     $$rulematch{$user}{$item} = $rule;
1.1226    raeburn  10054:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  10055:                                         if (ref($inst_results) eq 'HASH') {
                   10056:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   10057:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   10058:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1227    raeburn  10059:                                                 } elsif ($item eq 'id') {
                   10060:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   10061:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   10062:                                                     }
1.615     raeburn  10063:                                                 }
1.612     raeburn  10064:                                             }
                   10065:                                         }
1.615     raeburn  10066:                                     }
                   10067:                                     last;
1.585     raeburn  10068:                                 }
                   10069:                             }
                   10070:                         }
                   10071:                     }
                   10072:                 }
                   10073:             }
                   10074:         }
                   10075:     }
1.612     raeburn  10076:     return;
                   10077: }
                   10078: 
                   10079: sub user_rule_formats {
                   10080:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   10081:     my %text = ( 
                   10082:                  'username' => 'Usernames',
                   10083:                  'id'       => 'IDs',
                   10084:                );
                   10085:     my $output;
                   10086:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   10087:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   10088:         if (@{$ruleorder} > 0) {
1.1102    raeburn  10089:             $output = '<br />'.
                   10090:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   10091:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   10092:                       ' <ul>';
1.612     raeburn  10093:             foreach my $rule (@{$ruleorder}) {
                   10094:                 if (ref($curr_rules) eq 'ARRAY') {
                   10095:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   10096:                         if (ref($rules->{$rule}) eq 'HASH') {
                   10097:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   10098:                                         $rules->{$rule}{'desc'}.'</li>';
                   10099:                         }
                   10100:                     }
                   10101:                 }
                   10102:             }
                   10103:             $output .= '</ul>';
                   10104:         }
                   10105:     }
                   10106:     return $output;
                   10107: }
                   10108: 
                   10109: sub instrule_disallow_msg {
1.615     raeburn  10110:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  10111:     my $response;
                   10112:     my %text = (
                   10113:                   item   => 'username',
                   10114:                   items  => 'usernames',
                   10115:                   match  => 'matches',
                   10116:                   do     => 'does',
                   10117:                   action => 'a username',
                   10118:                   one    => 'one',
                   10119:                );
                   10120:     if ($count > 1) {
                   10121:         $text{'item'} = 'usernames';
                   10122:         $text{'match'} ='match';
                   10123:         $text{'do'} = 'do';
                   10124:         $text{'action'} = 'usernames',
                   10125:         $text{'one'} = 'ones';
                   10126:     }
                   10127:     if ($checkitem eq 'id') {
                   10128:         $text{'items'} = 'IDs';
                   10129:         $text{'item'} = 'ID';
                   10130:         $text{'action'} = 'an ID';
1.615     raeburn  10131:         if ($count > 1) {
                   10132:             $text{'item'} = 'IDs';
                   10133:             $text{'action'} = 'IDs';
                   10134:         }
1.612     raeburn  10135:     }
1.674     bisitz   10136:     $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  10137:     if ($mode eq 'upload') {
                   10138:         if ($checkitem eq 'username') {
                   10139:             $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'}.");
                   10140:         } elsif ($checkitem eq 'id') {
1.674     bisitz   10141:             $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  10142:         }
1.669     raeburn  10143:     } elsif ($mode eq 'selfcreate') {
                   10144:         if ($checkitem eq 'id') {
                   10145:             $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.");
                   10146:         }
1.615     raeburn  10147:     } else {
                   10148:         if ($checkitem eq 'username') {
                   10149:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   10150:         } elsif ($checkitem eq 'id') {
                   10151:             $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.");
                   10152:         }
1.612     raeburn  10153:     }
                   10154:     return $response;
1.585     raeburn  10155: }
                   10156: 
1.624     raeburn  10157: sub personal_data_fieldtitles {
                   10158:     my %fieldtitles = &Apache::lonlocal::texthash (
                   10159:                         id => 'Student/Employee ID',
                   10160:                         permanentemail => 'E-mail address',
                   10161:                         lastname => 'Last Name',
                   10162:                         firstname => 'First Name',
                   10163:                         middlename => 'Middle Name',
                   10164:                         generation => 'Generation',
                   10165:                         gen => 'Generation',
1.765     raeburn  10166:                         inststatus => 'Affiliation',
1.624     raeburn  10167:                    );
                   10168:     return %fieldtitles;
                   10169: }
                   10170: 
1.642     raeburn  10171: sub sorted_inst_types {
                   10172:     my ($dom) = @_;
1.1185    raeburn  10173:     my ($usertypes,$order);
                   10174:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   10175:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   10176:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   10177:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   10178:     } else {
                   10179:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   10180:     }
1.642     raeburn  10181:     my $othertitle = &mt('All users');
                   10182:     if ($env{'request.course.id'}) {
1.668     raeburn  10183:         $othertitle  = &mt('Any users');
1.642     raeburn  10184:     }
                   10185:     my @types;
                   10186:     if (ref($order) eq 'ARRAY') {
                   10187:         @types = @{$order};
                   10188:     }
                   10189:     if (@types == 0) {
                   10190:         if (ref($usertypes) eq 'HASH') {
                   10191:             @types = sort(keys(%{$usertypes}));
                   10192:         }
                   10193:     }
                   10194:     if (keys(%{$usertypes}) > 0) {
                   10195:         $othertitle = &mt('Other users');
                   10196:     }
                   10197:     return ($othertitle,$usertypes,\@types);
                   10198: }
                   10199: 
1.645     raeburn  10200: sub get_institutional_codes {
                   10201:     my ($settings,$allcourses,$LC_code) = @_;
                   10202: # Get complete list of course sections to update
                   10203:     my @currsections = ();
                   10204:     my @currxlists = ();
                   10205:     my $coursecode = $$settings{'internal.coursecode'};
                   10206: 
                   10207:     if ($$settings{'internal.sectionnums'} ne '') {
                   10208:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   10209:     }
                   10210: 
                   10211:     if ($$settings{'internal.crosslistings'} ne '') {
                   10212:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   10213:     }
                   10214: 
                   10215:     if (@currxlists > 0) {
                   10216:         foreach (@currxlists) {
                   10217:             if (m/^([^:]+):(\w*)$/) {
                   10218:                 unless (grep/^$1$/,@{$allcourses}) {
                   10219:                     push @{$allcourses},$1;
                   10220:                     $$LC_code{$1} = $2;
                   10221:                 }
                   10222:             }
                   10223:         }
                   10224:     }
                   10225:  
                   10226:     if (@currsections > 0) {
                   10227:         foreach (@currsections) {
                   10228:             if (m/^(\w+):(\w*)$/) {
                   10229:                 my $sec = $coursecode.$1;
                   10230:                 my $lc_sec = $2;
                   10231:                 unless (grep/^$sec$/,@{$allcourses}) {
                   10232:                     push @{$allcourses},$sec;
                   10233:                     $$LC_code{$sec} = $lc_sec;
                   10234:                 }
                   10235:             }
                   10236:         }
                   10237:     }
                   10238:     return;
                   10239: }
                   10240: 
1.971     raeburn  10241: sub get_standard_codeitems {
                   10242:     return ('Year','Semester','Department','Number','Section');
                   10243: }
                   10244: 
1.112     bowersj2 10245: =pod
                   10246: 
1.780     raeburn  10247: =head1 Slot Helpers
                   10248: 
                   10249: =over 4
                   10250: 
                   10251: =item * sorted_slots()
                   10252: 
1.1040    raeburn  10253: Sorts an array of slot names in order of an optional sort key,
                   10254: default sort is by slot start time (earliest first). 
1.780     raeburn  10255: 
                   10256: Inputs:
                   10257: 
                   10258: =over 4
                   10259: 
                   10260: slotsarr  - Reference to array of unsorted slot names.
                   10261: 
                   10262: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   10263: 
1.1040    raeburn  10264: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   10265: 
1.549     albertel 10266: =back
                   10267: 
1.780     raeburn  10268: Returns:
                   10269: 
                   10270: =over 4
                   10271: 
1.1040    raeburn  10272: sorted   - An array of slot names sorted by a specified sort key 
                   10273:            (default sort key is start time of the slot).
1.780     raeburn  10274: 
                   10275: =back
                   10276: 
                   10277: =cut
                   10278: 
                   10279: 
                   10280: sub sorted_slots {
1.1040    raeburn  10281:     my ($slotsarr,$slots,$sortkey) = @_;
                   10282:     if ($sortkey eq '') {
                   10283:         $sortkey = 'starttime';
                   10284:     }
1.780     raeburn  10285:     my @sorted;
                   10286:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   10287:         @sorted =
                   10288:             sort {
                   10289:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  10290:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  10291:                      }
                   10292:                      if (ref($slots->{$a})) { return -1;}
                   10293:                      if (ref($slots->{$b})) { return 1;}
                   10294:                      return 0;
                   10295:                  } @{$slotsarr};
                   10296:     }
                   10297:     return @sorted;
                   10298: }
                   10299: 
1.1040    raeburn  10300: =pod
                   10301: 
                   10302: =item * get_future_slots()
                   10303: 
                   10304: Inputs:
                   10305: 
                   10306: =over 4
                   10307: 
                   10308: cnum - course number
                   10309: 
                   10310: cdom - course domain
                   10311: 
                   10312: now - current UNIX time
                   10313: 
                   10314: symb - optional symb
                   10315: 
                   10316: =back
                   10317: 
                   10318: Returns:
                   10319: 
                   10320: =over 4
                   10321: 
                   10322: sorted_reservable - ref to array of student_schedulable slots currently 
                   10323:                     reservable, ordered by end date of reservation period.
                   10324: 
                   10325: reservable_now - ref to hash of student_schedulable slots currently
                   10326:                  reservable.
                   10327: 
                   10328:     Keys in inner hash are:
                   10329:     (a) symb: either blank or symb to which slot use is restricted.
                   10330:     (b) endreserve: end date of reservation period. 
                   10331: 
                   10332: sorted_future - ref to array of student_schedulable slots reservable in
                   10333:                 the future, ordered by start date of reservation period.
                   10334: 
                   10335: future_reservable - ref to hash of student_schedulable slots reservable
                   10336:                     in the future.
                   10337: 
                   10338:     Keys in inner hash are:
                   10339:     (a) symb: either blank or symb to which slot use is restricted.
                   10340:     (b) startreserve:  start date of reservation period.
                   10341: 
                   10342: =back
                   10343: 
                   10344: =cut
                   10345: 
                   10346: sub get_future_slots {
                   10347:     my ($cnum,$cdom,$now,$symb) = @_;
1.1229    raeburn  10348:     my $map;
                   10349:     if ($symb) {
                   10350:         ($map) = &Apache::lonnet::decode_symb($symb);
                   10351:     }
1.1040    raeburn  10352:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   10353:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   10354:     foreach my $slot (keys(%slots)) {
                   10355:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   10356:         if ($symb) {
1.1229    raeburn  10357:             if ($slots{$slot}->{'symb'} ne '') {
                   10358:                 my $canuse;
                   10359:                 my %oksymbs;
                   10360:                 my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   10361:                 map { $oksymbs{$_} = 1; } @slotsymbs;
                   10362:                 if ($oksymbs{$symb}) {
                   10363:                     $canuse = 1;
                   10364:                 } else {
                   10365:                     foreach my $item (@slotsymbs) {
                   10366:                         if ($item =~ /\.(page|sequence)$/) {
                   10367:                             (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                   10368:                             if (($map ne '') && ($map eq $sloturl)) {
                   10369:                                 $canuse = 1;
                   10370:                                 last;
                   10371:                             }
                   10372:                         }
                   10373:                     }
                   10374:                 }
                   10375:                 next unless ($canuse);
                   10376:             }
1.1040    raeburn  10377:         }
                   10378:         if (($slots{$slot}->{'starttime'} > $now) &&
                   10379:             ($slots{$slot}->{'endtime'} > $now)) {
                   10380:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   10381:                 my $userallowed = 0;
                   10382:                 if ($slots{$slot}->{'allowedsections'}) {
                   10383:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   10384:                     if (!defined($env{'request.role.sec'})
                   10385:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   10386:                         $userallowed=1;
                   10387:                     } else {
                   10388:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   10389:                             $userallowed=1;
                   10390:                         }
                   10391:                     }
                   10392:                     unless ($userallowed) {
                   10393:                         if (defined($env{'request.course.groups'})) {
                   10394:                             my @groups = split(/:/,$env{'request.course.groups'});
                   10395:                             foreach my $group (@groups) {
                   10396:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   10397:                                     $userallowed=1;
                   10398:                                     last;
                   10399:                                 }
                   10400:                             }
                   10401:                         }
                   10402:                     }
                   10403:                 }
                   10404:                 if ($slots{$slot}->{'allowedusers'}) {
                   10405:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   10406:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   10407:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   10408:                         $userallowed = 1;
                   10409:                     }
                   10410:                 }
                   10411:                 next unless($userallowed);
                   10412:             }
                   10413:             my $startreserve = $slots{$slot}->{'startreserve'};
                   10414:             my $endreserve = $slots{$slot}->{'endreserve'};
                   10415:             my $symb = $slots{$slot}->{'symb'};
                   10416:             if (($startreserve < $now) &&
                   10417:                 (!$endreserve || $endreserve > $now)) {
                   10418:                 my $lastres = $endreserve;
                   10419:                 if (!$lastres) {
                   10420:                     $lastres = $slots{$slot}->{'starttime'};
                   10421:                 }
                   10422:                 $reservable_now{$slot} = {
                   10423:                                            symb       => $symb,
                   10424:                                            endreserve => $lastres
                   10425:                                          };
                   10426:             } elsif (($startreserve > $now) &&
                   10427:                      (!$endreserve || $endreserve > $startreserve)) {
                   10428:                 $future_reservable{$slot} = {
                   10429:                                               symb         => $symb,
                   10430:                                               startreserve => $startreserve
                   10431:                                             };
                   10432:             }
                   10433:         }
                   10434:     }
                   10435:     my @unsorted_reservable = keys(%reservable_now);
                   10436:     if (@unsorted_reservable > 0) {
                   10437:         @sorted_reservable = 
                   10438:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   10439:     }
                   10440:     my @unsorted_future = keys(%future_reservable);
                   10441:     if (@unsorted_future > 0) {
                   10442:         @sorted_future =
                   10443:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   10444:     }
                   10445:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   10446: }
1.780     raeburn  10447: 
                   10448: =pod
                   10449: 
1.1057    foxr     10450: =back
                   10451: 
1.549     albertel 10452: =head1 HTTP Helpers
                   10453: 
                   10454: =over 4
                   10455: 
1.648     raeburn  10456: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 10457: 
1.258     albertel 10458: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 10459: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 10460: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 10461: 
                   10462: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   10463: $possible_names is an ref to an array of form element names.  As an example:
                   10464: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 10465: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 10466: 
                   10467: =cut
1.1       albertel 10468: 
1.6       albertel 10469: sub get_unprocessed_cgi {
1.25      albertel 10470:   my ($query,$possible_names)= @_;
1.26      matthew  10471:   # $Apache::lonxml::debug=1;
1.356     albertel 10472:   foreach my $pair (split(/&/,$query)) {
                   10473:     my ($name, $value) = split(/=/,$pair);
1.369     www      10474:     $name = &unescape($name);
1.25      albertel 10475:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   10476:       $value =~ tr/+/ /;
                   10477:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10478:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10479:     }
1.16      harris41 10480:   }
1.6       albertel 10481: }
                   10482: 
1.112     bowersj2 10483: =pod
                   10484: 
1.648     raeburn  10485: =item * &cacheheader() 
1.112     bowersj2 10486: 
                   10487: returns cache-controlling header code
                   10488: 
                   10489: =cut
                   10490: 
1.7       albertel 10491: sub cacheheader {
1.258     albertel 10492:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10493:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10494:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10495:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10496:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10497:     return $output;
1.7       albertel 10498: }
                   10499: 
1.112     bowersj2 10500: =pod
                   10501: 
1.648     raeburn  10502: =item * &no_cache($r) 
1.112     bowersj2 10503: 
                   10504: specifies header code to not have cache
                   10505: 
                   10506: =cut
                   10507: 
1.9       albertel 10508: sub no_cache {
1.216     albertel 10509:     my ($r) = @_;
                   10510:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10511: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10512:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10513:     $r->no_cache(1);
                   10514:     $r->header_out("Expires" => $date);
                   10515:     $r->header_out("Pragma" => "no-cache");
1.123     www      10516: }
                   10517: 
                   10518: sub content_type {
1.181     albertel 10519:     my ($r,$type,$charset) = @_;
1.299     foxr     10520:     if ($r) {
                   10521: 	#  Note that printout.pl calls this with undef for $r.
                   10522: 	&no_cache($r);
                   10523:     }
1.258     albertel 10524:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10525:     unless ($charset) {
                   10526: 	$charset=&Apache::lonlocal::current_encoding;
                   10527:     }
                   10528:     if ($charset) { $type.='; charset='.$charset; }
                   10529:     if ($r) {
                   10530: 	$r->content_type($type);
                   10531:     } else {
                   10532: 	print("Content-type: $type\n\n");
                   10533:     }
1.9       albertel 10534: }
1.25      albertel 10535: 
1.112     bowersj2 10536: =pod
                   10537: 
1.648     raeburn  10538: =item * &add_to_env($name,$value) 
1.112     bowersj2 10539: 
1.258     albertel 10540: adds $name to the %env hash with value
1.112     bowersj2 10541: $value, if $name already exists, the entry is converted to an array
                   10542: reference and $value is added to the array.
                   10543: 
                   10544: =cut
                   10545: 
1.25      albertel 10546: sub add_to_env {
                   10547:   my ($name,$value)=@_;
1.258     albertel 10548:   if (defined($env{$name})) {
                   10549:     if (ref($env{$name})) {
1.25      albertel 10550:       #already have multiple values
1.258     albertel 10551:       push(@{ $env{$name} },$value);
1.25      albertel 10552:     } else {
                   10553:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 10554:       my $first=$env{$name};
                   10555:       undef($env{$name});
                   10556:       push(@{ $env{$name} },$first,$value);
1.25      albertel 10557:     }
                   10558:   } else {
1.258     albertel 10559:     $env{$name}=$value;
1.25      albertel 10560:   }
1.31      albertel 10561: }
1.149     albertel 10562: 
                   10563: =pod
                   10564: 
1.648     raeburn  10565: =item * &get_env_multiple($name) 
1.149     albertel 10566: 
1.258     albertel 10567: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 10568: values may be defined and end up as an array ref.
                   10569: 
                   10570: returns an array of values
                   10571: 
                   10572: =cut
                   10573: 
                   10574: sub get_env_multiple {
                   10575:     my ($name) = @_;
                   10576:     my @values;
1.258     albertel 10577:     if (defined($env{$name})) {
1.149     albertel 10578:         # exists is it an array
1.258     albertel 10579:         if (ref($env{$name})) {
                   10580:             @values=@{ $env{$name} };
1.149     albertel 10581:         } else {
1.258     albertel 10582:             $values[0]=$env{$name};
1.149     albertel 10583:         }
                   10584:     }
                   10585:     return(@values);
                   10586: }
                   10587: 
1.660     raeburn  10588: sub ask_for_embedded_content {
                   10589:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  10590:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  10591:         %currsubfile,%unused,$rem);
1.1071    raeburn  10592:     my $counter = 0;
                   10593:     my $numnew = 0;
1.987     raeburn  10594:     my $numremref = 0;
                   10595:     my $numinvalid = 0;
                   10596:     my $numpathchg = 0;
                   10597:     my $numexisting = 0;
1.1071    raeburn  10598:     my $numunused = 0;
                   10599:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  10600:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  10601:     my $heading = &mt('Upload embedded files');
                   10602:     my $buttontext = &mt('Upload');
                   10603: 
1.1085    raeburn  10604:     if ($env{'request.course.id'}) {
1.1123    raeburn  10605:         if ($actionurl eq '/adm/dependencies') {
                   10606:             $navmap = Apache::lonnavmaps::navmap->new();
                   10607:         }
                   10608:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   10609:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  10610:     }
1.1123    raeburn  10611:     if (($actionurl eq '/adm/portfolio') || 
                   10612:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  10613:         my $current_path='/';
                   10614:         if ($env{'form.currentpath'}) {
                   10615:             $current_path = $env{'form.currentpath'};
                   10616:         }
                   10617:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  10618:             $udom = $cdom;
                   10619:             $uname = $cnum;
1.984     raeburn  10620:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   10621:         } else {
                   10622:             $udom = $env{'user.domain'};
                   10623:             $uname = $env{'user.name'};
                   10624:             $url = '/userfiles/portfolio';
                   10625:         }
1.987     raeburn  10626:         $toplevel = $url.'/';
1.984     raeburn  10627:         $url .= $current_path;
                   10628:         $getpropath = 1;
1.987     raeburn  10629:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   10630:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      10631:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  10632:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  10633:         $toplevel = $url;
1.984     raeburn  10634:         if ($rest ne '') {
1.987     raeburn  10635:             $url .= $rest;
                   10636:         }
                   10637:     } elsif ($actionurl eq '/adm/coursedocs') {
                   10638:         if (ref($args) eq 'HASH') {
1.1071    raeburn  10639:             $url = $args->{'docs_url'};
                   10640:             $toplevel = $url;
1.1084    raeburn  10641:             if ($args->{'context'} eq 'paste') {
                   10642:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   10643:                 ($path) = 
                   10644:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10645:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10646:                 $fileloc =~ s{^/}{};
                   10647:             }
1.1071    raeburn  10648:         }
1.1084    raeburn  10649:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  10650:         if ($env{'request.course.id'} ne '') {
                   10651:             if (ref($args) eq 'HASH') {
                   10652:                 $url = $args->{'docs_url'};
                   10653:                 $title = $args->{'docs_title'};
1.1126    raeburn  10654:                 $toplevel = $url; 
                   10655:                 unless ($toplevel =~ m{^/}) {
                   10656:                     $toplevel = "/$url";
                   10657:                 }
1.1085    raeburn  10658:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  10659:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   10660:                     $path = $1;
                   10661:                 } else {
                   10662:                     ($path) =
                   10663:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10664:                 }
1.1195    raeburn  10665:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   10666:                     $fileloc = $toplevel;
                   10667:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   10668:                     my ($udom,$uname,$fname) =
                   10669:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   10670:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   10671:                 } else {
                   10672:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10673:                 }
1.1071    raeburn  10674:                 $fileloc =~ s{^/}{};
                   10675:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   10676:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   10677:             }
1.987     raeburn  10678:         }
1.1123    raeburn  10679:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10680:         $udom = $cdom;
                   10681:         $uname = $cnum;
                   10682:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   10683:         $toplevel = $url;
                   10684:         $path = $url;
                   10685:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   10686:         $fileloc =~ s{^/}{};
1.987     raeburn  10687:     }
1.1126    raeburn  10688:     foreach my $file (keys(%{$allfiles})) {
                   10689:         my $embed_file;
                   10690:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   10691:             $embed_file = $1;
                   10692:         } else {
                   10693:             $embed_file = $file;
                   10694:         }
1.1158    raeburn  10695:         my ($absolutepath,$cleaned_file);
                   10696:         if ($embed_file =~ m{^\w+://}) {
                   10697:             $cleaned_file = $embed_file;
1.1147    raeburn  10698:             $newfiles{$cleaned_file} = 1;
                   10699:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10700:         } else {
1.1158    raeburn  10701:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  10702:             if ($embed_file =~ m{^/}) {
                   10703:                 $absolutepath = $embed_file;
                   10704:             }
1.1147    raeburn  10705:             if ($cleaned_file =~ m{/}) {
                   10706:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  10707:                 $path = &check_for_traversal($path,$url,$toplevel);
                   10708:                 my $item = $fname;
                   10709:                 if ($path ne '') {
                   10710:                     $item = $path.'/'.$fname;
                   10711:                     $subdependencies{$path}{$fname} = 1;
                   10712:                 } else {
                   10713:                     $dependencies{$item} = 1;
                   10714:                 }
                   10715:                 if ($absolutepath) {
                   10716:                     $mapping{$item} = $absolutepath;
                   10717:                 } else {
                   10718:                     $mapping{$item} = $embed_file;
                   10719:                 }
                   10720:             } else {
                   10721:                 $dependencies{$embed_file} = 1;
                   10722:                 if ($absolutepath) {
1.1147    raeburn  10723:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  10724:                 } else {
1.1147    raeburn  10725:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10726:                 }
                   10727:             }
1.984     raeburn  10728:         }
                   10729:     }
1.1071    raeburn  10730:     my $dirptr = 16384;
1.984     raeburn  10731:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  10732:         $currsubfile{$path} = {};
1.1123    raeburn  10733:         if (($actionurl eq '/adm/portfolio') || 
                   10734:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10735:             my ($sublistref,$listerror) =
                   10736:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   10737:             if (ref($sublistref) eq 'ARRAY') {
                   10738:                 foreach my $line (@{$sublistref}) {
                   10739:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  10740:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  10741:                 }
1.984     raeburn  10742:             }
1.987     raeburn  10743:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10744:             if (opendir(my $dir,$url.'/'.$path)) {
                   10745:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  10746:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   10747:             }
1.1084    raeburn  10748:         } elsif (($actionurl eq '/adm/dependencies') ||
                   10749:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10750:                   ($args->{'context'} eq 'paste')) ||
                   10751:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10752:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  10753:                 my $dir;
                   10754:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10755:                     $dir = $fileloc;
                   10756:                 } else {
                   10757:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10758:                 }
1.1071    raeburn  10759:                 if ($dir ne '') {
                   10760:                     my ($sublistref,$listerror) =
                   10761:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10762:                     if (ref($sublistref) eq 'ARRAY') {
                   10763:                         foreach my $line (@{$sublistref}) {
                   10764:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10765:                                 undef,$mtime)=split(/\&/,$line,12);
                   10766:                             unless (($testdir&$dirptr) ||
                   10767:                                     ($file_name =~ /^\.\.?$/)) {
                   10768:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10769:                             }
                   10770:                         }
                   10771:                     }
                   10772:                 }
1.984     raeburn  10773:             }
                   10774:         }
                   10775:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10776:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10777:                 my $item = $path.'/'.$file;
                   10778:                 unless ($mapping{$item} eq $item) {
                   10779:                     $pathchanges{$item} = 1;
                   10780:                 }
                   10781:                 $existing{$item} = 1;
                   10782:                 $numexisting ++;
                   10783:             } else {
                   10784:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10785:             }
                   10786:         }
1.1071    raeburn  10787:         if ($actionurl eq '/adm/dependencies') {
                   10788:             foreach my $path (keys(%currsubfile)) {
                   10789:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10790:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10791:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  10792:                              next if (($rem ne '') &&
                   10793:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10794:                                        (ref($navmap) &&
                   10795:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10796:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10797:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10798:                              $unused{$path.'/'.$file} = 1; 
                   10799:                          }
                   10800:                     }
                   10801:                 }
                   10802:             }
                   10803:         }
1.984     raeburn  10804:     }
1.987     raeburn  10805:     my %currfile;
1.1123    raeburn  10806:     if (($actionurl eq '/adm/portfolio') ||
                   10807:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10808:         my ($dirlistref,$listerror) =
                   10809:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10810:         if (ref($dirlistref) eq 'ARRAY') {
                   10811:             foreach my $line (@{$dirlistref}) {
                   10812:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10813:                 $currfile{$file_name} = 1;
                   10814:             }
1.984     raeburn  10815:         }
1.987     raeburn  10816:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10817:         if (opendir(my $dir,$url)) {
1.987     raeburn  10818:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10819:             map {$currfile{$_} = 1;} @dir_list;
                   10820:         }
1.1084    raeburn  10821:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10822:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10823:               ($args->{'context'} eq 'paste')) ||
                   10824:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10825:         if ($env{'request.course.id'} ne '') {
                   10826:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10827:             if ($dir ne '') {
                   10828:                 my ($dirlistref,$listerror) =
                   10829:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10830:                 if (ref($dirlistref) eq 'ARRAY') {
                   10831:                     foreach my $line (@{$dirlistref}) {
                   10832:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10833:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10834:                         unless (($testdir&$dirptr) ||
                   10835:                                 ($file_name =~ /^\.\.?$/)) {
                   10836:                             $currfile{$file_name} = [$size,$mtime];
                   10837:                         }
                   10838:                     }
                   10839:                 }
                   10840:             }
                   10841:         }
1.984     raeburn  10842:     }
                   10843:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10844:         if (exists($currfile{$file})) {
1.987     raeburn  10845:             unless ($mapping{$file} eq $file) {
                   10846:                 $pathchanges{$file} = 1;
                   10847:             }
                   10848:             $existing{$file} = 1;
                   10849:             $numexisting ++;
                   10850:         } else {
1.984     raeburn  10851:             $newfiles{$file} = 1;
                   10852:         }
                   10853:     }
1.1071    raeburn  10854:     foreach my $file (keys(%currfile)) {
                   10855:         unless (($file eq $filename) ||
                   10856:                 ($file eq $filename.'.bak') ||
                   10857:                 ($dependencies{$file})) {
1.1085    raeburn  10858:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10859:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10860:                     next if (($rem ne '') &&
                   10861:                              (($env{"httpref.$rem".$file} ne '') ||
                   10862:                               (ref($navmap) &&
                   10863:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10864:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10865:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10866:                 }
1.1085    raeburn  10867:             }
1.1071    raeburn  10868:             $unused{$file} = 1;
                   10869:         }
                   10870:     }
1.1084    raeburn  10871:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10872:         ($args->{'context'} eq 'paste')) {
                   10873:         $counter = scalar(keys(%existing));
                   10874:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10875:         return ($output,$counter,$numpathchg,\%existing);
                   10876:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10877:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10878:         $counter = scalar(keys(%existing));
                   10879:         $numpathchg = scalar(keys(%pathchanges));
                   10880:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10881:     }
1.984     raeburn  10882:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10883:         if ($actionurl eq '/adm/dependencies') {
                   10884:             next if ($embed_file =~ m{^\w+://});
                   10885:         }
1.660     raeburn  10886:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10887:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10888:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10889:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10890:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10891:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10892:         }
1.1123    raeburn  10893:         $upload_output .= '</td>';
1.1071    raeburn  10894:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10895:             $upload_output.='<td align="right">'.
                   10896:                             '<span class="LC_info LC_fontsize_medium">'.
                   10897:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10898:             $numremref++;
1.660     raeburn  10899:         } elsif ($args->{'error_on_invalid_names'}
                   10900:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10901:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10902:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10903:             $numinvalid++;
1.660     raeburn  10904:         } else {
1.1123    raeburn  10905:             $upload_output .= '<td>'.
                   10906:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10907:                                                      $embed_file,\%mapping,
1.1071    raeburn  10908:                                                      $allfiles,$codebase,'upload');
                   10909:             $counter ++;
                   10910:             $numnew ++;
1.987     raeburn  10911:         }
                   10912:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10913:     }
                   10914:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10915:         if ($actionurl eq '/adm/dependencies') {
                   10916:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10917:             $modify_output .= &start_data_table_row().
                   10918:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10919:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10920:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10921:                               '<td>'.$size.'</td>'.
                   10922:                               '<td>'.$mtime.'</td>'.
                   10923:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10924:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10925:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10926:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10927:                               &embedded_file_element('upload_embedded',$counter,
                   10928:                                                      $embed_file,\%mapping,
                   10929:                                                      $allfiles,$codebase,'modify').
                   10930:                               '</div></td>'.
                   10931:                               &end_data_table_row()."\n";
                   10932:             $counter ++;
                   10933:         } else {
                   10934:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10935:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10936:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10937:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10938:                               &Apache::loncommon::end_data_table_row()."\n";
                   10939:         }
                   10940:     }
                   10941:     my $delidx = $counter;
                   10942:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10943:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10944:         $delete_output .= &start_data_table_row().
                   10945:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10946:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10947:                           '<td>'.$size.'</td>'.
                   10948:                           '<td>'.$mtime.'</td>'.
                   10949:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10950:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10951:                           &embedded_file_element('upload_embedded',$delidx,
                   10952:                                                  $oldfile,\%mapping,$allfiles,
                   10953:                                                  $codebase,'delete').'</td>'.
                   10954:                           &end_data_table_row()."\n"; 
                   10955:         $numunused ++;
                   10956:         $delidx ++;
1.987     raeburn  10957:     }
                   10958:     if ($upload_output) {
                   10959:         $upload_output = &start_data_table().
                   10960:                          $upload_output.
                   10961:                          &end_data_table()."\n";
                   10962:     }
1.1071    raeburn  10963:     if ($modify_output) {
                   10964:         $modify_output = &start_data_table().
                   10965:                          &start_data_table_header_row().
                   10966:                          '<th>'.&mt('File').'</th>'.
                   10967:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10968:                          '<th>'.&mt('Modified').'</th>'.
                   10969:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10970:                          &end_data_table_header_row().
                   10971:                          $modify_output.
                   10972:                          &end_data_table()."\n";
                   10973:     }
                   10974:     if ($delete_output) {
                   10975:         $delete_output = &start_data_table().
                   10976:                          &start_data_table_header_row().
                   10977:                          '<th>'.&mt('File').'</th>'.
                   10978:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10979:                          '<th>'.&mt('Modified').'</th>'.
                   10980:                          '<th>'.&mt('Delete?').'</th>'.
                   10981:                          &end_data_table_header_row().
                   10982:                          $delete_output.
                   10983:                          &end_data_table()."\n";
                   10984:     }
1.987     raeburn  10985:     my $applies = 0;
                   10986:     if ($numremref) {
                   10987:         $applies ++;
                   10988:     }
                   10989:     if ($numinvalid) {
                   10990:         $applies ++;
                   10991:     }
                   10992:     if ($numexisting) {
                   10993:         $applies ++;
                   10994:     }
1.1071    raeburn  10995:     if ($counter || $numunused) {
1.987     raeburn  10996:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10997:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10998:                   $state.'<h3>'.$heading.'</h3>'; 
                   10999:         if ($actionurl eq '/adm/dependencies') {
                   11000:             if ($numnew) {
                   11001:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   11002:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   11003:                            $upload_output.'<br />'."\n";
                   11004:             }
                   11005:             if ($numexisting) {
                   11006:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   11007:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   11008:                            $modify_output.'<br />'."\n";
                   11009:                            $buttontext = &mt('Save changes');
                   11010:             }
                   11011:             if ($numunused) {
                   11012:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   11013:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   11014:                            $delete_output.'<br />'."\n";
                   11015:                            $buttontext = &mt('Save changes');
                   11016:             }
                   11017:         } else {
                   11018:             $output .= $upload_output.'<br />'."\n";
                   11019:         }
                   11020:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   11021:                    $counter.'" />'."\n";
                   11022:         if ($actionurl eq '/adm/dependencies') { 
                   11023:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   11024:                        $numnew.'" />'."\n";
                   11025:         } elsif ($actionurl eq '') {
1.987     raeburn  11026:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   11027:         }
                   11028:     } elsif ($applies) {
                   11029:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   11030:         if ($applies > 1) {
                   11031:             $output .=  
1.1123    raeburn  11032:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  11033:             if ($numremref) {
                   11034:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   11035:             }
                   11036:             if ($numinvalid) {
                   11037:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   11038:             }
                   11039:             if ($numexisting) {
                   11040:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   11041:             }
                   11042:             $output .= '</ul><br />';
                   11043:         } elsif ($numremref) {
                   11044:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   11045:         } elsif ($numinvalid) {
                   11046:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   11047:         } elsif ($numexisting) {
                   11048:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   11049:         }
                   11050:         $output .= $upload_output.'<br />';
                   11051:     }
                   11052:     my ($pathchange_output,$chgcount);
1.1071    raeburn  11053:     $chgcount = $counter;
1.987     raeburn  11054:     if (keys(%pathchanges) > 0) {
                   11055:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  11056:             if ($counter) {
1.987     raeburn  11057:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   11058:                                                   $embed_file,\%mapping,
1.1071    raeburn  11059:                                                   $allfiles,$codebase,'change');
1.987     raeburn  11060:             } else {
                   11061:                 $pathchange_output .= 
                   11062:                     &start_data_table_row().
                   11063:                     '<td><input type ="checkbox" name="namechange" value="'.
                   11064:                     $chgcount.'" checked="checked" /></td>'.
                   11065:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   11066:                     '<td>'.$embed_file.
                   11067:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  11068:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  11069:                     '</td>'.&end_data_table_row();
1.660     raeburn  11070:             }
1.987     raeburn  11071:             $numpathchg ++;
                   11072:             $chgcount ++;
1.660     raeburn  11073:         }
                   11074:     }
1.1127    raeburn  11075:     if (($counter) || ($numunused)) {
1.987     raeburn  11076:         if ($numpathchg) {
                   11077:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   11078:                        $numpathchg.'" />'."\n";
                   11079:         }
                   11080:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   11081:             ($actionurl eq '/adm/imsimport')) {
                   11082:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   11083:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   11084:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  11085:         } elsif ($actionurl eq '/adm/dependencies') {
                   11086:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  11087:         }
1.1123    raeburn  11088:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  11089:     } elsif ($numpathchg) {
                   11090:         my %pathchange = ();
                   11091:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   11092:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11093:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  11094:         }
1.987     raeburn  11095:     }
1.1071    raeburn  11096:     return ($output,$counter,$numpathchg);
1.987     raeburn  11097: }
                   11098: 
1.1147    raeburn  11099: =pod
                   11100: 
                   11101: =item * clean_path($name)
                   11102: 
                   11103: Performs clean-up of directories, subdirectories and filename in an
                   11104: embedded object, referenced in an HTML file which is being uploaded
                   11105: to a course or portfolio, where 
                   11106: "Upload embedded images/multimedia files if HTML file" checkbox was
                   11107: checked.
                   11108: 
                   11109: Clean-up is similar to replacements in lonnet::clean_filename()
                   11110: except each / between sub-directory and next level is preserved.
                   11111: 
                   11112: =cut
                   11113: 
                   11114: sub clean_path {
                   11115:     my ($embed_file) = @_;
                   11116:     $embed_file =~s{^/+}{};
                   11117:     my @contents;
                   11118:     if ($embed_file =~ m{/}) {
                   11119:         @contents = split(/\//,$embed_file);
                   11120:     } else {
                   11121:         @contents = ($embed_file);
                   11122:     }
                   11123:     my $lastidx = scalar(@contents)-1;
                   11124:     for (my $i=0; $i<=$lastidx; $i++) { 
                   11125:         $contents[$i]=~s{\\}{/}g;
                   11126:         $contents[$i]=~s/\s+/\_/g;
                   11127:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   11128:         if ($i == $lastidx) {
                   11129:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   11130:         }
                   11131:     }
                   11132:     if ($lastidx > 0) {
                   11133:         return join('/',@contents);
                   11134:     } else {
                   11135:         return $contents[0];
                   11136:     }
                   11137: }
                   11138: 
1.987     raeburn  11139: sub embedded_file_element {
1.1071    raeburn  11140:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  11141:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   11142:                    (ref($codebase) eq 'HASH'));
                   11143:     my $output;
1.1071    raeburn  11144:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  11145:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   11146:     }
                   11147:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   11148:                &escape($embed_file).'" />';
                   11149:     unless (($context eq 'upload_embedded') && 
                   11150:             ($mapping->{$embed_file} eq $embed_file)) {
                   11151:         $output .='
                   11152:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   11153:     }
                   11154:     my $attrib;
                   11155:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   11156:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   11157:     }
                   11158:     $output .=
                   11159:         "\n\t\t".
                   11160:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   11161:         $attrib.'" />';
                   11162:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   11163:         $output .=
                   11164:             "\n\t\t".
                   11165:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   11166:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  11167:     }
1.987     raeburn  11168:     return $output;
1.660     raeburn  11169: }
                   11170: 
1.1071    raeburn  11171: sub get_dependency_details {
                   11172:     my ($currfile,$currsubfile,$embed_file) = @_;
                   11173:     my ($size,$mtime,$showsize,$showmtime);
                   11174:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   11175:         if ($embed_file =~ m{/}) {
                   11176:             my ($path,$fname) = split(/\//,$embed_file);
                   11177:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   11178:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   11179:             }
                   11180:         } else {
                   11181:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   11182:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   11183:             }
                   11184:         }
                   11185:         $showsize = $size/1024.0;
                   11186:         $showsize = sprintf("%.1f",$showsize);
                   11187:         if ($mtime > 0) {
                   11188:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   11189:         }
                   11190:     }
                   11191:     return ($showsize,$showmtime);
                   11192: }
                   11193: 
                   11194: sub ask_embedded_js {
                   11195:     return <<"END";
                   11196: <script type="text/javascript"">
                   11197: // <![CDATA[
                   11198: function toggleBrowse(counter) {
                   11199:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   11200:     var fileid = document.getElementById('embedded_item_'+counter);
                   11201:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   11202:     if (chkboxid.checked == true) {
                   11203:         uploaddivid.style.display='block';
                   11204:     } else {
                   11205:         uploaddivid.style.display='none';
                   11206:         fileid.value = '';
                   11207:     }
                   11208: }
                   11209: // ]]>
                   11210: </script>
                   11211: 
                   11212: END
                   11213: }
                   11214: 
1.661     raeburn  11215: sub upload_embedded {
                   11216:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  11217:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   11218:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  11219:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   11220:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   11221:         my $orig_uploaded_filename =
                   11222:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  11223:         foreach my $type ('orig','ref','attrib','codebase') {
                   11224:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   11225:                 $env{'form.embedded_'.$type.'_'.$i} =
                   11226:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   11227:             }
                   11228:         }
1.661     raeburn  11229:         my ($path,$fname) =
                   11230:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   11231:         # no path, whole string is fname
                   11232:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   11233:         $fname = &Apache::lonnet::clean_filename($fname);
                   11234:         # See if there is anything left
                   11235:         next if ($fname eq '');
                   11236: 
                   11237:         # Check if file already exists as a file or directory.
                   11238:         my ($state,$msg);
                   11239:         if ($context eq 'portfolio') {
                   11240:             my $port_path = $dirpath;
                   11241:             if ($group ne '') {
                   11242:                 $port_path = "groups/$group/$port_path";
                   11243:             }
1.987     raeburn  11244:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   11245:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  11246:                                               $dir_root,$port_path,$disk_quota,
                   11247:                                               $current_disk_usage,$uname,$udom);
                   11248:             if ($state eq 'will_exceed_quota'
1.984     raeburn  11249:                 || $state eq 'file_locked') {
1.661     raeburn  11250:                 $output .= $msg;
                   11251:                 next;
                   11252:             }
                   11253:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   11254:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   11255:             if ($state eq 'exists') {
                   11256:                 $output .= $msg;
                   11257:                 next;
                   11258:             }
                   11259:         }
                   11260:         # Check if extension is valid
                   11261:         if (($fname =~ /\.(\w+)$/) &&
                   11262:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   11263:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   11264:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  11265:             next;
                   11266:         } elsif (($fname =~ /\.(\w+)$/) &&
                   11267:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  11268:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  11269:             next;
                   11270:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   11271:             $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  11272:             next;
                   11273:         }
                   11274:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  11275:         my $subdir = $path;
                   11276:         $subdir =~ s{/+$}{};
1.661     raeburn  11277:         if ($context eq 'portfolio') {
1.984     raeburn  11278:             my $result;
                   11279:             if ($state eq 'existingfile') {
                   11280:                 $result=
                   11281:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  11282:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  11283:             } else {
1.984     raeburn  11284:                 $result=
                   11285:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  11286:                                                     $dirpath.
1.1123    raeburn  11287:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  11288:                 if ($result !~ m|^/uploaded/|) {
                   11289:                     $output .= '<span class="LC_error">'
                   11290:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11291:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11292:                                .'</span><br />';
                   11293:                     next;
                   11294:                 } else {
1.987     raeburn  11295:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11296:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  11297:                 }
1.661     raeburn  11298:             }
1.1123    raeburn  11299:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  11300:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   11301:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  11302:             my $result =
1.1126    raeburn  11303:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  11304:             if ($result !~ m|^/uploaded/|) {
                   11305:                 $output .= '<span class="LC_error">'
                   11306:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11307:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11308:                            .'</span><br />';
                   11309:                     next;
                   11310:             } else {
                   11311:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11312:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  11313:                 if ($context eq 'syllabus') {
                   11314:                     &Apache::lonnet::make_public_indefinitely($result);
                   11315:                 }
1.987     raeburn  11316:             }
1.661     raeburn  11317:         } else {
                   11318: # Save the file
                   11319:             my $target = $env{'form.embedded_item_'.$i};
                   11320:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   11321:             my $dest = $fullpath.$fname;
                   11322:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  11323:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  11324:             my $count;
                   11325:             my $filepath = $dir_root;
1.1027    raeburn  11326:             foreach my $subdir (@parts) {
                   11327:                 $filepath .= "/$subdir";
                   11328:                 if (!-e $filepath) {
1.661     raeburn  11329:                     mkdir($filepath,0770);
                   11330:                 }
                   11331:             }
                   11332:             my $fh;
                   11333:             if (!open($fh,'>'.$dest)) {
                   11334:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   11335:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  11336:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   11337:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11338:                            '</span><br />';
                   11339:             } else {
                   11340:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   11341:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   11342:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  11343:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   11344:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11345:                               '</span><br />';
                   11346:                 } else {
1.987     raeburn  11347:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11348:                                $url.'</span>').'<br />';
                   11349:                     unless ($context eq 'testbank') {
                   11350:                         $footer .= &mt('View embedded file: [_1]',
                   11351:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   11352:                     }
                   11353:                 }
                   11354:                 close($fh);
                   11355:             }
                   11356:         }
                   11357:         if ($env{'form.embedded_ref_'.$i}) {
                   11358:             $pathchange{$i} = 1;
                   11359:         }
                   11360:     }
                   11361:     if ($output) {
                   11362:         $output = '<p>'.$output.'</p>';
                   11363:     }
                   11364:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   11365:     $returnflag = 'ok';
1.1071    raeburn  11366:     my $numpathchgs = scalar(keys(%pathchange));
                   11367:     if ($numpathchgs > 0) {
1.987     raeburn  11368:         if ($context eq 'portfolio') {
                   11369:             $output .= '<p>'.&mt('or').'</p>';
                   11370:         } elsif ($context eq 'testbank') {
1.1071    raeburn  11371:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   11372:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  11373:             $returnflag = 'modify_orightml';
                   11374:         }
                   11375:     }
1.1071    raeburn  11376:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  11377: }
                   11378: 
                   11379: sub modify_html_form {
                   11380:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   11381:     my $end = 0;
                   11382:     my $modifyform;
                   11383:     if ($context eq 'upload_embedded') {
                   11384:         return unless (ref($pathchange) eq 'HASH');
                   11385:         if ($env{'form.number_embedded_items'}) {
                   11386:             $end += $env{'form.number_embedded_items'};
                   11387:         }
                   11388:         if ($env{'form.number_pathchange_items'}) {
                   11389:             $end += $env{'form.number_pathchange_items'};
                   11390:         }
                   11391:         if ($end) {
                   11392:             for (my $i=0; $i<$end; $i++) {
                   11393:                 if ($i < $env{'form.number_embedded_items'}) {
                   11394:                     next unless($pathchange->{$i});
                   11395:                 }
                   11396:                 $modifyform .=
                   11397:                     &start_data_table_row().
                   11398:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   11399:                     'checked="checked" /></td>'.
                   11400:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   11401:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   11402:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   11403:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   11404:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   11405:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   11406:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   11407:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   11408:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   11409:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   11410:                     &end_data_table_row();
1.1071    raeburn  11411:             }
1.987     raeburn  11412:         }
                   11413:     } else {
                   11414:         $modifyform = $pathchgtable;
                   11415:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   11416:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   11417:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11418:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   11419:         }
                   11420:     }
                   11421:     if ($modifyform) {
1.1071    raeburn  11422:         if ($actionurl eq '/adm/dependencies') {
                   11423:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   11424:         }
1.987     raeburn  11425:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   11426:                '<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".
                   11427:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   11428:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   11429:                '</ol></p>'."\n".'<p>'.
                   11430:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   11431:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   11432:                &start_data_table()."\n".
                   11433:                &start_data_table_header_row().
                   11434:                '<th>'.&mt('Change?').'</th>'.
                   11435:                '<th>'.&mt('Current reference').'</th>'.
                   11436:                '<th>'.&mt('Required reference').'</th>'.
                   11437:                &end_data_table_header_row()."\n".
                   11438:                $modifyform.
                   11439:                &end_data_table().'<br />'."\n".$hiddenstate.
                   11440:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   11441:                '</form>'."\n";
                   11442:     }
                   11443:     return;
                   11444: }
                   11445: 
                   11446: sub modify_html_refs {
1.1123    raeburn  11447:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  11448:     my $container;
                   11449:     if ($context eq 'portfolio') {
                   11450:         $container = $env{'form.container'};
                   11451:     } elsif ($context eq 'coursedoc') {
                   11452:         $container = $env{'form.primaryurl'};
1.1071    raeburn  11453:     } elsif ($context eq 'manage_dependencies') {
                   11454:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   11455:         $container = "/$container";
1.1123    raeburn  11456:     } elsif ($context eq 'syllabus') {
                   11457:         $container = $url;
1.987     raeburn  11458:     } else {
1.1027    raeburn  11459:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  11460:     }
                   11461:     my (%allfiles,%codebase,$output,$content);
                   11462:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  11463:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  11464:         if (wantarray) {
                   11465:             return ('',0,0); 
                   11466:         } else {
                   11467:             return;
                   11468:         }
                   11469:     }
                   11470:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11471:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  11472:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   11473:             if (wantarray) {
                   11474:                 return ('',0,0);
                   11475:             } else {
                   11476:                 return;
                   11477:             }
                   11478:         } 
1.987     raeburn  11479:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  11480:         if ($content eq '-1') {
                   11481:             if (wantarray) {
                   11482:                 return ('',0,0);
                   11483:             } else {
                   11484:                 return;
                   11485:             }
                   11486:         }
1.987     raeburn  11487:     } else {
1.1071    raeburn  11488:         unless ($container =~ /^\Q$dir_root\E/) {
                   11489:             if (wantarray) {
                   11490:                 return ('',0,0);
                   11491:             } else {
                   11492:                 return;
                   11493:             }
                   11494:         } 
1.987     raeburn  11495:         if (open(my $fh,"<$container")) {
                   11496:             $content = join('', <$fh>);
                   11497:             close($fh);
                   11498:         } else {
1.1071    raeburn  11499:             if (wantarray) {
                   11500:                 return ('',0,0);
                   11501:             } else {
                   11502:                 return;
                   11503:             }
1.987     raeburn  11504:         }
                   11505:     }
                   11506:     my ($count,$codebasecount) = (0,0);
                   11507:     my $mm = new File::MMagic;
                   11508:     my $mime_type = $mm->checktype_contents($content);
                   11509:     if ($mime_type eq 'text/html') {
                   11510:         my $parse_result = 
                   11511:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   11512:                                                     \%codebase,\$content);
                   11513:         if ($parse_result eq 'ok') {
                   11514:             foreach my $i (@changes) {
                   11515:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   11516:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   11517:                 if ($allfiles{$ref}) {
                   11518:                     my $newname =  $orig;
                   11519:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  11520:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  11521:                     if ($attrib_regexp =~ /:/) {
                   11522:                         $attrib_regexp =~ s/\:/|/g;
                   11523:                     }
                   11524:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11525:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11526:                         $count += $numchg;
1.1123    raeburn  11527:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  11528:                         delete($allfiles{$ref});
1.987     raeburn  11529:                     }
                   11530:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  11531:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  11532:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   11533:                         $codebasecount ++;
                   11534:                     }
                   11535:                 }
                   11536:             }
1.1123    raeburn  11537:             my $skiprewrites;
1.987     raeburn  11538:             if ($count || $codebasecount) {
                   11539:                 my $saveresult;
1.1071    raeburn  11540:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11541:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  11542:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11543:                     if ($url eq $container) {
                   11544:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   11545:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11546:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  11547:                                             $fname.'</span>').'</p>';
1.987     raeburn  11548:                     } else {
                   11549:                          $output = '<p class="LC_error">'.
                   11550:                                    &mt('Error: update failed for: [_1].',
                   11551:                                    '<span class="LC_filename">'.
                   11552:                                    $container.'</span>').'</p>';
                   11553:                     }
1.1123    raeburn  11554:                     if ($context eq 'syllabus') {
                   11555:                         unless ($saveresult eq 'ok') {
                   11556:                             $skiprewrites = 1;
                   11557:                         }
                   11558:                     }
1.987     raeburn  11559:                 } else {
                   11560:                     if (open(my $fh,">$container")) {
                   11561:                         print $fh $content;
                   11562:                         close($fh);
                   11563:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11564:                                   $count,'<span class="LC_filename">'.
                   11565:                                   $container.'</span>').'</p>';
1.661     raeburn  11566:                     } else {
1.987     raeburn  11567:                          $output = '<p class="LC_error">'.
                   11568:                                    &mt('Error: could not update [_1].',
                   11569:                                    '<span class="LC_filename">'.
                   11570:                                    $container.'</span>').'</p>';
1.661     raeburn  11571:                     }
                   11572:                 }
                   11573:             }
1.1123    raeburn  11574:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   11575:                 my ($actionurl,$state);
                   11576:                 $actionurl = "/public/$udom/$uname/syllabus";
                   11577:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   11578:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   11579:                                               \%codebase,
                   11580:                                               {'context' => 'rewrites',
                   11581:                                                'ignore_remote_references' => 1,});
                   11582:                 if (ref($mapping) eq 'HASH') {
                   11583:                     my $rewrites = 0;
                   11584:                     foreach my $key (keys(%{$mapping})) {
                   11585:                         next if ($key =~ m{^https?://});
                   11586:                         my $ref = $mapping->{$key};
                   11587:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   11588:                         my $attrib;
                   11589:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   11590:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   11591:                         }
                   11592:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11593:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11594:                             $rewrites += $numchg;
                   11595:                         }
                   11596:                     }
                   11597:                     if ($rewrites) {
                   11598:                         my $saveresult; 
                   11599:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11600:                         if ($url eq $container) {
                   11601:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   11602:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   11603:                                             $count,'<span class="LC_filename">'.
                   11604:                                             $fname.'</span>').'</p>';
                   11605:                         } else {
                   11606:                             $output .= '<p class="LC_error">'.
                   11607:                                        &mt('Error: could not update links in [_1].',
                   11608:                                        '<span class="LC_filename">'.
                   11609:                                        $container.'</span>').'</p>';
                   11610: 
                   11611:                         }
                   11612:                     }
                   11613:                 }
                   11614:             }
1.987     raeburn  11615:         } else {
                   11616:             &logthis('Failed to parse '.$container.
                   11617:                      ' to modify references: '.$parse_result);
1.661     raeburn  11618:         }
                   11619:     }
1.1071    raeburn  11620:     if (wantarray) {
                   11621:         return ($output,$count,$codebasecount);
                   11622:     } else {
                   11623:         return $output;
                   11624:     }
1.661     raeburn  11625: }
                   11626: 
                   11627: sub check_for_existing {
                   11628:     my ($path,$fname,$element) = @_;
                   11629:     my ($state,$msg);
                   11630:     if (-d $path.'/'.$fname) {
                   11631:         $state = 'exists';
                   11632:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11633:     } elsif (-e $path.'/'.$fname) {
                   11634:         $state = 'exists';
                   11635:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11636:     }
                   11637:     if ($state eq 'exists') {
                   11638:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   11639:     }
                   11640:     return ($state,$msg);
                   11641: }
                   11642: 
                   11643: sub check_for_upload {
                   11644:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   11645:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  11646:     my $filesize = length($env{'form.'.$element});
                   11647:     if (!$filesize) {
                   11648:         my $msg = '<span class="LC_error">'.
                   11649:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   11650:                       '<span class="LC_filename">'.$fname.'</span>',
                   11651:                       $filesize).'<br />'.
1.1007    raeburn  11652:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  11653:                   '</span>';
                   11654:         return ('zero_bytes',$msg);
                   11655:     }
                   11656:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  11657:     my $getpropath = 1;
1.1021    raeburn  11658:     my ($dirlistref,$listerror) =
                   11659:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  11660:     my $found_file = 0;
                   11661:     my $locked_file = 0;
1.991     raeburn  11662:     my @lockers;
                   11663:     my $navmap;
                   11664:     if ($env{'request.course.id'}) {
                   11665:         $navmap = Apache::lonnavmaps::navmap->new();
                   11666:     }
1.1021    raeburn  11667:     if (ref($dirlistref) eq 'ARRAY') {
                   11668:         foreach my $line (@{$dirlistref}) {
                   11669:             my ($file_name,$rest)=split(/\&/,$line,2);
                   11670:             if ($file_name eq $fname){
                   11671:                 $file_name = $path.$file_name;
                   11672:                 if ($group ne '') {
                   11673:                     $file_name = $group.$file_name;
                   11674:                 }
                   11675:                 $found_file = 1;
                   11676:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   11677:                     foreach my $lock (@lockers) {
                   11678:                         if (ref($lock) eq 'ARRAY') {
                   11679:                             my ($symb,$crsid) = @{$lock};
                   11680:                             if ($crsid eq $env{'request.course.id'}) {
                   11681:                                 if (ref($navmap)) {
                   11682:                                     my $res = $navmap->getBySymb($symb);
                   11683:                                     foreach my $part (@{$res->parts()}) { 
                   11684:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   11685:                                         unless (($slot_status == $res->RESERVED) ||
                   11686:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   11687:                                             $locked_file = 1;
                   11688:                                         }
1.991     raeburn  11689:                                     }
1.1021    raeburn  11690:                                 } else {
                   11691:                                     $locked_file = 1;
1.991     raeburn  11692:                                 }
                   11693:                             } else {
                   11694:                                 $locked_file = 1;
                   11695:                             }
                   11696:                         }
1.1021    raeburn  11697:                    }
                   11698:                 } else {
                   11699:                     my @info = split(/\&/,$rest);
                   11700:                     my $currsize = $info[6]/1000;
                   11701:                     if ($currsize < $filesize) {
                   11702:                         my $extra = $filesize - $currsize;
                   11703:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   11704:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  11705:                                       &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   11706:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   11707:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   11708:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  11709:                             return ('will_exceed_quota',$msg);
                   11710:                         }
1.984     raeburn  11711:                     }
                   11712:                 }
1.661     raeburn  11713:             }
                   11714:         }
                   11715:     }
                   11716:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   11717:         my $msg = '<p class="LC_warning">'.
                   11718:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184    raeburn  11719:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  11720:         return ('will_exceed_quota',$msg);
                   11721:     } elsif ($found_file) {
                   11722:         if ($locked_file) {
1.1179    bisitz   11723:             my $msg = '<p class="LC_warning">';
1.661     raeburn  11724:             $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   11725:             $msg .= '</p>';
1.661     raeburn  11726:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   11727:             return ('file_locked',$msg);
                   11728:         } else {
1.1179    bisitz   11729:             my $msg = '<p class="LC_error">';
1.984     raeburn  11730:             $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   11731:             $msg .= '</p>';
1.984     raeburn  11732:             return ('existingfile',$msg);
1.661     raeburn  11733:         }
                   11734:     }
                   11735: }
                   11736: 
1.987     raeburn  11737: sub check_for_traversal {
                   11738:     my ($path,$url,$toplevel) = @_;
                   11739:     my @parts=split(/\//,$path);
                   11740:     my $cleanpath;
                   11741:     my $fullpath = $url;
                   11742:     for (my $i=0;$i<@parts;$i++) {
                   11743:         next if ($parts[$i] eq '.');
                   11744:         if ($parts[$i] eq '..') {
                   11745:             $fullpath =~ s{([^/]+/)$}{};
                   11746:         } else {
                   11747:             $fullpath .= $parts[$i].'/';
                   11748:         }
                   11749:     }
                   11750:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   11751:         $cleanpath = $1;
                   11752:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11753:         my $curr_toprel = $1;
                   11754:         my @parts = split(/\//,$curr_toprel);
                   11755:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11756:         my @urlparts = split(/\//,$url_toprel);
                   11757:         my $doubledots;
                   11758:         my $startdiff = -1;
                   11759:         for (my $i=0; $i<@urlparts; $i++) {
                   11760:             if ($startdiff == -1) {
                   11761:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11762:                     $startdiff = $i;
                   11763:                     $doubledots .= '../';
                   11764:                 }
                   11765:             } else {
                   11766:                 $doubledots .= '../';
                   11767:             }
                   11768:         }
                   11769:         if ($startdiff > -1) {
                   11770:             $cleanpath = $doubledots;
                   11771:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11772:                 $cleanpath .= $parts[$i].'/';
                   11773:             }
                   11774:         }
                   11775:     }
                   11776:     $cleanpath =~ s{(/)$}{};
                   11777:     return $cleanpath;
                   11778: }
1.31      albertel 11779: 
1.1053    raeburn  11780: sub is_archive_file {
                   11781:     my ($mimetype) = @_;
                   11782:     if (($mimetype eq 'application/octet-stream') ||
                   11783:         ($mimetype eq 'application/x-stuffit') ||
                   11784:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11785:         return 1;
                   11786:     }
                   11787:     return;
                   11788: }
                   11789: 
                   11790: sub decompress_form {
1.1065    raeburn  11791:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11792:     my %lt = &Apache::lonlocal::texthash (
                   11793:         this => 'This file is an archive file.',
1.1067    raeburn  11794:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11795:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11796:         youm => 'You may wish to extract its contents.',
                   11797:         extr => 'Extract contents',
1.1067    raeburn  11798:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11799:         proa => 'Process automatically?',
1.1053    raeburn  11800:         yes  => 'Yes',
                   11801:         no   => 'No',
1.1067    raeburn  11802:         fold => 'Title for folder containing movie',
                   11803:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11804:     );
1.1065    raeburn  11805:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11806:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11807:     my $info = &list_archive_contents($fileloc,\@paths);
                   11808:     if (@paths) {
                   11809:         foreach my $path (@paths) {
                   11810:             $path =~ s{^/}{};
1.1067    raeburn  11811:             if ($path =~ m{^([^/]+)/$}) {
                   11812:                 $topdir = $1;
                   11813:             }
1.1065    raeburn  11814:             if ($path =~ m{^([^/]+)/}) {
                   11815:                 $toplevel{$1} = $path;
                   11816:             } else {
                   11817:                 $toplevel{$path} = $path;
                   11818:             }
                   11819:         }
                   11820:     }
1.1067    raeburn  11821:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  11822:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11823:                         "$topdir/media/",
                   11824:                         "$topdir/media/$topdir.mp4",
                   11825:                         "$topdir/media/FirstFrame.png",
                   11826:                         "$topdir/media/player.swf",
                   11827:                         "$topdir/media/swfobject.js",
                   11828:                         "$topdir/media/expressInstall.swf");
1.1197    raeburn  11829:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164    raeburn  11830:                          "$topdir/$topdir.mp4",
                   11831:                          "$topdir/$topdir\_config.xml",
                   11832:                          "$topdir/$topdir\_controller.swf",
                   11833:                          "$topdir/$topdir\_embed.css",
                   11834:                          "$topdir/$topdir\_First_Frame.png",
                   11835:                          "$topdir/$topdir\_player.html",
                   11836:                          "$topdir/$topdir\_Thumbnails.png",
                   11837:                          "$topdir/playerProductInstall.swf",
                   11838:                          "$topdir/scripts/",
                   11839:                          "$topdir/scripts/config_xml.js",
                   11840:                          "$topdir/scripts/handlebars.js",
                   11841:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11842:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11843:                          "$topdir/scripts/modernizr.js",
                   11844:                          "$topdir/scripts/player-min.js",
                   11845:                          "$topdir/scripts/swfobject.js",
                   11846:                          "$topdir/skins/",
                   11847:                          "$topdir/skins/configuration_express.xml",
                   11848:                          "$topdir/skins/express_show/",
                   11849:                          "$topdir/skins/express_show/player-min.css",
                   11850:                          "$topdir/skins/express_show/spritesheet.png");
1.1197    raeburn  11851:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11852:                          "$topdir/$topdir.mp4",
                   11853:                          "$topdir/$topdir\_config.xml",
                   11854:                          "$topdir/$topdir\_controller.swf",
                   11855:                          "$topdir/$topdir\_embed.css",
                   11856:                          "$topdir/$topdir\_First_Frame.png",
                   11857:                          "$topdir/$topdir\_player.html",
                   11858:                          "$topdir/$topdir\_Thumbnails.png",
                   11859:                          "$topdir/playerProductInstall.swf",
                   11860:                          "$topdir/scripts/",
                   11861:                          "$topdir/scripts/config_xml.js",
                   11862:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11863:                          "$topdir/skins/",
                   11864:                          "$topdir/skins/configuration_express.xml",
                   11865:                          "$topdir/skins/express_show/",
                   11866:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11867:                          "$topdir/skins/express_show/spritesheet.png",
                   11868:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164    raeburn  11869:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11870:         if (@diffs == 0) {
1.1164    raeburn  11871:             $is_camtasia = 6;
                   11872:         } else {
1.1197    raeburn  11873:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164    raeburn  11874:             if (@diffs == 0) {
                   11875:                 $is_camtasia = 8;
1.1197    raeburn  11876:             } else {
                   11877:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11878:                 if (@diffs == 0) {
                   11879:                     $is_camtasia = 8;
                   11880:                 }
1.1164    raeburn  11881:             }
1.1067    raeburn  11882:         }
                   11883:     }
                   11884:     my $output;
                   11885:     if ($is_camtasia) {
                   11886:         $output = <<"ENDCAM";
                   11887: <script type="text/javascript" language="Javascript">
                   11888: // <![CDATA[
                   11889: 
                   11890: function camtasiaToggle() {
                   11891:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11892:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  11893:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11894:                 document.getElementById('camtasia_titles').style.display='block';
                   11895:             } else {
                   11896:                 document.getElementById('camtasia_titles').style.display='none';
                   11897:             }
                   11898:         }
                   11899:     }
                   11900:     return;
                   11901: }
                   11902: 
                   11903: // ]]>
                   11904: </script>
                   11905: <p>$lt{'camt'}</p>
                   11906: ENDCAM
1.1065    raeburn  11907:     } else {
1.1067    raeburn  11908:         $output = '<p>'.$lt{'this'};
                   11909:         if ($info eq '') {
                   11910:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11911:         } else {
                   11912:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11913:                        '<div><pre>'.$info.'</pre></div>';
                   11914:         }
1.1065    raeburn  11915:     }
1.1067    raeburn  11916:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11917:     my $duplicates;
                   11918:     my $num = 0;
                   11919:     if (ref($dirlist) eq 'ARRAY') {
                   11920:         foreach my $item (@{$dirlist}) {
                   11921:             if (ref($item) eq 'ARRAY') {
                   11922:                 if (exists($toplevel{$item->[0]})) {
                   11923:                     $duplicates .= 
                   11924:                         &start_data_table_row().
                   11925:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11926:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11927:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11928:                         'value="1" />'.&mt('Yes').'</label>'.
                   11929:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11930:                         '<td>'.$item->[0].'</td>';
                   11931:                     if ($item->[2]) {
                   11932:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11933:                     } else {
                   11934:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11935:                     }
                   11936:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11937:                                    '<td>'.
                   11938:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11939:                                    '</td>'.
                   11940:                                    &end_data_table_row();
                   11941:                     $num ++;
                   11942:                 }
                   11943:             }
                   11944:         }
                   11945:     }
                   11946:     my $itemcount;
                   11947:     if (@paths > 0) {
                   11948:         $itemcount = scalar(@paths);
                   11949:     } else {
                   11950:         $itemcount = 1;
                   11951:     }
1.1067    raeburn  11952:     if ($is_camtasia) {
                   11953:         $output .= $lt{'auto'}.'<br />'.
                   11954:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  11955:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11956:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11957:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11958:                    $lt{'no'}.'</label></span><br />'.
                   11959:                    '<div id="camtasia_titles" style="display:block">'.
                   11960:                    &Apache::lonhtmlcommon::start_pick_box().
                   11961:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11962:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11963:                    &Apache::lonhtmlcommon::row_closure().
                   11964:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11965:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11966:                    &Apache::lonhtmlcommon::row_closure(1).
                   11967:                    &Apache::lonhtmlcommon::end_pick_box().
                   11968:                    '</div>';
                   11969:     }
1.1065    raeburn  11970:     $output .= 
                   11971:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11972:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11973:         "\n";
1.1065    raeburn  11974:     if ($duplicates ne '') {
                   11975:         $output .= '<p><span class="LC_warning">'.
                   11976:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11977:                    &start_data_table().
                   11978:                    &start_data_table_header_row().
                   11979:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11980:                    '<th>'.&mt('Name').'</th>'.
                   11981:                    '<th>'.&mt('Type').'</th>'.
                   11982:                    '<th>'.&mt('Size').'</th>'.
                   11983:                    '<th>'.&mt('Last modified').'</th>'.
                   11984:                    &end_data_table_header_row().
                   11985:                    $duplicates.
                   11986:                    &end_data_table().
                   11987:                    '</p>';
                   11988:     }
1.1067    raeburn  11989:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11990:     if (ref($hiddenelements) eq 'HASH') {
                   11991:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11992:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11993:         }
                   11994:     }
                   11995:     $output .= <<"END";
1.1067    raeburn  11996: <br />
1.1053    raeburn  11997: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11998: </form>
                   11999: $noextract
                   12000: END
                   12001:     return $output;
                   12002: }
                   12003: 
1.1065    raeburn  12004: sub decompression_utility {
                   12005:     my ($program) = @_;
                   12006:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   12007:     my $location;
                   12008:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   12009:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   12010:                          '/usr/sbin/') {
                   12011:             if (-x $dir.$program) {
                   12012:                 $location = $dir.$program;
                   12013:                 last;
                   12014:             }
                   12015:         }
                   12016:     }
                   12017:     return $location;
                   12018: }
                   12019: 
                   12020: sub list_archive_contents {
                   12021:     my ($file,$pathsref) = @_;
                   12022:     my (@cmd,$output);
                   12023:     my $needsregexp;
                   12024:     if ($file =~ /\.zip$/) {
                   12025:         @cmd = (&decompression_utility('unzip'),"-l");
                   12026:         $needsregexp = 1;
                   12027:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   12028:              ($file =~ /\.tgz$/)) {
                   12029:         @cmd = (&decompression_utility('tar'),"-ztf");
                   12030:     } elsif ($file =~ /\.tar\.bz2$/) {
                   12031:         @cmd = (&decompression_utility('tar'),"-jtf");
                   12032:     } elsif ($file =~ m|\.tar$|) {
                   12033:         @cmd = (&decompression_utility('tar'),"-tf");
                   12034:     }
                   12035:     if (@cmd) {
                   12036:         undef($!);
                   12037:         undef($@);
                   12038:         if (open(my $fh,"-|", @cmd, $file)) {
                   12039:             while (my $line = <$fh>) {
                   12040:                 $output .= $line;
                   12041:                 chomp($line);
                   12042:                 my $item;
                   12043:                 if ($needsregexp) {
                   12044:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   12045:                 } else {
                   12046:                     $item = $line;
                   12047:                 }
                   12048:                 if ($item ne '') {
                   12049:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   12050:                         push(@{$pathsref},$item);
                   12051:                     } 
                   12052:                 }
                   12053:             }
                   12054:             close($fh);
                   12055:         }
                   12056:     }
                   12057:     return $output;
                   12058: }
                   12059: 
1.1053    raeburn  12060: sub decompress_uploaded_file {
                   12061:     my ($file,$dir) = @_;
                   12062:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   12063:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   12064:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   12065:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   12066:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   12067:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   12068:     my $decompressed = $env{'cgi.decompressed'};
                   12069:     &Apache::lonnet::delenv('cgi.file');
                   12070:     &Apache::lonnet::delenv('cgi.dir');
                   12071:     &Apache::lonnet::delenv('cgi.decompressed');
                   12072:     return ($decompressed,$result);
                   12073: }
                   12074: 
1.1055    raeburn  12075: sub process_decompression {
                   12076:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   12077:     my ($dir,$error,$warning,$output);
1.1180    raeburn  12078:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   12079:         $error = &mt('Filename not a supported archive file type.').
                   12080:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  12081:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   12082:     } else {
                   12083:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12084:         if ($docuhome eq 'no_host') {
                   12085:             $error = &mt('Could not determine home server for course.');
                   12086:         } else {
                   12087:             my @ids=&Apache::lonnet::current_machine_ids();
                   12088:             my $currdir = "$dir_root/$destination";
                   12089:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12090:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   12091:                        "$dir_root/$destination";
                   12092:             } else {
                   12093:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   12094:                        "$dir_root/$docudom/$docuname/$destination";
                   12095:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   12096:                     $error = &mt('Archive file not found.');
                   12097:                 }
                   12098:             }
1.1065    raeburn  12099:             my (@to_overwrite,@to_skip);
                   12100:             if ($env{'form.archive_overwrite_total'} > 0) {
                   12101:                 my $total = $env{'form.archive_overwrite_total'};
                   12102:                 for (my $i=0; $i<$total; $i++) {
                   12103:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   12104:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   12105:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   12106:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   12107:                     }
                   12108:                 }
                   12109:             }
                   12110:             my $numskip = scalar(@to_skip);
                   12111:             if (($numskip > 0) && 
                   12112:                 ($numskip == $env{'form.archive_itemcount'})) {
                   12113:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   12114:             } elsif ($dir eq '') {
1.1055    raeburn  12115:                 $error = &mt('Directory containing archive file unavailable.');
                   12116:             } elsif (!$error) {
1.1065    raeburn  12117:                 my ($decompressed,$display);
                   12118:                 if ($numskip > 0) {
                   12119:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   12120:                     mkdir("$dir/$tempdir",0755);
                   12121:                     system("mv $dir/$file $dir/$tempdir/$file");
                   12122:                     ($decompressed,$display) = 
                   12123:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   12124:                     foreach my $item (@to_skip) {
                   12125:                         if (($item ne '') && ($item !~ /\.\./)) {
                   12126:                             if (-f "$dir/$tempdir/$item") { 
                   12127:                                 unlink("$dir/$tempdir/$item");
                   12128:                             } elsif (-d "$dir/$tempdir/$item") {
                   12129:                                 system("rm -rf $dir/$tempdir/$item");
                   12130:                             }
                   12131:                         }
                   12132:                     }
                   12133:                     system("mv $dir/$tempdir/* $dir");
                   12134:                     rmdir("$dir/$tempdir");   
                   12135:                 } else {
                   12136:                     ($decompressed,$display) = 
                   12137:                         &decompress_uploaded_file($file,$dir);
                   12138:                 }
1.1055    raeburn  12139:                 if ($decompressed eq 'ok') {
1.1065    raeburn  12140:                     $output = '<p class="LC_info">'.
                   12141:                               &mt('Files extracted successfully from archive.').
                   12142:                               '</p>'."\n";
1.1055    raeburn  12143:                     my ($warning,$result,@contents);
                   12144:                     my ($newdirlistref,$newlisterror) =
                   12145:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   12146:                                                  $docuname,1);
                   12147:                     my (%is_dir,%changes,@newitems);
                   12148:                     my $dirptr = 16384;
1.1065    raeburn  12149:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  12150:                         foreach my $dir_line (@{$newdirlistref}) {
                   12151:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  12152:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   12153:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  12154:                                 push(@newitems,$item);
                   12155:                                 if ($dirptr&$testdir) {
                   12156:                                     $is_dir{$item} = 1;
                   12157:                                 }
                   12158:                                 $changes{$item} = 1;
                   12159:                             }
                   12160:                         }
                   12161:                     }
                   12162:                     if (keys(%changes) > 0) {
                   12163:                         foreach my $item (sort(@newitems)) {
                   12164:                             if ($changes{$item}) {
                   12165:                                 push(@contents,$item);
                   12166:                             }
                   12167:                         }
                   12168:                     }
                   12169:                     if (@contents > 0) {
1.1067    raeburn  12170:                         my $wantform;
                   12171:                         unless ($env{'form.autoextract_camtasia'}) {
                   12172:                             $wantform = 1;
                   12173:                         }
1.1056    raeburn  12174:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  12175:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   12176:                                                                 $currdir,\%is_dir,
                   12177:                                                                 \%children,\%parent,
1.1056    raeburn  12178:                                                                 \@contents,\%dirorder,
                   12179:                                                                 \%titles,$wantform);
1.1055    raeburn  12180:                         if ($datatable ne '') {
                   12181:                             $output .= &archive_options_form('decompressed',$datatable,
                   12182:                                                              $count,$hiddenelem);
1.1065    raeburn  12183:                             my $startcount = 6;
1.1055    raeburn  12184:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  12185:                                                            \%titles,\%children);
1.1055    raeburn  12186:                         }
1.1067    raeburn  12187:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  12188:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  12189:                             my %displayed;
                   12190:                             my $total = 1;
                   12191:                             $env{'form.archive_directory'} = [];
                   12192:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   12193:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   12194:                                 $path =~ s{/$}{};
                   12195:                                 my $item;
                   12196:                                 if ($path ne '') {
                   12197:                                     $item = "$path/$titles{$i}";
                   12198:                                 } else {
                   12199:                                     $item = $titles{$i};
                   12200:                                 }
                   12201:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   12202:                                 if ($item eq $contents[0]) {
                   12203:                                     push(@{$env{'form.archive_directory'}},$i);
                   12204:                                     $env{'form.archive_'.$i} = 'display';
                   12205:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   12206:                                     $displayed{'folder'} = $i;
1.1164    raeburn  12207:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   12208:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  12209:                                     $env{'form.archive_'.$i} = 'display';
                   12210:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   12211:                                     $displayed{'web'} = $i;
                   12212:                                 } else {
1.1164    raeburn  12213:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   12214:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   12215:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  12216:                                         push(@{$env{'form.archive_directory'}},$i);
                   12217:                                     }
                   12218:                                     $env{'form.archive_'.$i} = 'dependency';
                   12219:                                 }
                   12220:                                 $total ++;
                   12221:                             }
                   12222:                             for (my $i=1; $i<$total; $i++) {
                   12223:                                 next if ($i == $displayed{'web'});
                   12224:                                 next if ($i == $displayed{'folder'});
                   12225:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   12226:                             }
                   12227:                             $env{'form.phase'} = 'decompress_cleanup';
                   12228:                             $env{'form.archivedelete'} = 1;
                   12229:                             $env{'form.archive_count'} = $total-1;
                   12230:                             $output .=
                   12231:                                 &process_extracted_files('coursedocs',$docudom,
                   12232:                                                          $docuname,$destination,
                   12233:                                                          $dir_root,$hiddenelem);
                   12234:                         }
1.1055    raeburn  12235:                     } else {
                   12236:                         $warning = &mt('No new items extracted from archive file.');
                   12237:                     }
                   12238:                 } else {
                   12239:                     $output = $display;
                   12240:                     $error = &mt('An error occurred during extraction from the archive file.');
                   12241:                 }
                   12242:             }
                   12243:         }
                   12244:     }
                   12245:     if ($error) {
                   12246:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12247:                    $error.'</p>'."\n";
                   12248:     }
                   12249:     if ($warning) {
                   12250:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12251:     }
                   12252:     return $output;
                   12253: }
                   12254: 
                   12255: sub get_extracted {
1.1056    raeburn  12256:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   12257:         $titles,$wantform) = @_;
1.1055    raeburn  12258:     my $count = 0;
                   12259:     my $depth = 0;
                   12260:     my $datatable;
1.1056    raeburn  12261:     my @hierarchy;
1.1055    raeburn  12262:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  12263:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   12264:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  12265:     foreach my $item (@{$contents}) {
                   12266:         $count ++;
1.1056    raeburn  12267:         @{$dirorder->{$count}} = @hierarchy;
                   12268:         $titles->{$count} = $item;
1.1055    raeburn  12269:         &archive_hierarchy($depth,$count,$parent,$children);
                   12270:         if ($wantform) {
                   12271:             $datatable .= &archive_row($is_dir->{$item},$item,
                   12272:                                        $currdir,$depth,$count);
                   12273:         }
                   12274:         if ($is_dir->{$item}) {
                   12275:             $depth ++;
1.1056    raeburn  12276:             push(@hierarchy,$count);
                   12277:             $parent->{$depth} = $count;
1.1055    raeburn  12278:             $datatable .=
                   12279:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  12280:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   12281:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  12282:             $depth --;
1.1056    raeburn  12283:             pop(@hierarchy);
1.1055    raeburn  12284:         }
                   12285:     }
                   12286:     return ($count,$datatable);
                   12287: }
                   12288: 
                   12289: sub recurse_extracted_archive {
1.1056    raeburn  12290:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   12291:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  12292:     my $result='';
1.1056    raeburn  12293:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   12294:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   12295:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  12296:         return $result;
                   12297:     }
                   12298:     my $dirptr = 16384;
                   12299:     my ($newdirlistref,$newlisterror) =
                   12300:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   12301:     if (ref($newdirlistref) eq 'ARRAY') {
                   12302:         foreach my $dir_line (@{$newdirlistref}) {
                   12303:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   12304:             unless ($item =~ /^\.+$/) {
                   12305:                 $$count ++;
1.1056    raeburn  12306:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   12307:                 $titles->{$$count} = $item;
1.1055    raeburn  12308:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  12309: 
1.1055    raeburn  12310:                 my $is_dir;
                   12311:                 if ($dirptr&$testdir) {
                   12312:                     $is_dir = 1;
                   12313:                 }
                   12314:                 if ($wantform) {
                   12315:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   12316:                 }
                   12317:                 if ($is_dir) {
                   12318:                     $$depth ++;
1.1056    raeburn  12319:                     push(@{$hierarchy},$$count);
                   12320:                     $parent->{$$depth} = $$count;
1.1055    raeburn  12321:                     $result .=
                   12322:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   12323:                                                    $docuname,$depth,$count,
1.1056    raeburn  12324:                                                    $hierarchy,$dirorder,$children,
                   12325:                                                    $parent,$titles,$wantform);
1.1055    raeburn  12326:                     $$depth --;
1.1056    raeburn  12327:                     pop(@{$hierarchy});
1.1055    raeburn  12328:                 }
                   12329:             }
                   12330:         }
                   12331:     }
                   12332:     return $result;
                   12333: }
                   12334: 
                   12335: sub archive_hierarchy {
                   12336:     my ($depth,$count,$parent,$children) =@_;
                   12337:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   12338:         if (exists($parent->{$depth})) {
                   12339:              $children->{$parent->{$depth}} .= $count.':';
                   12340:         }
                   12341:     }
                   12342:     return;
                   12343: }
                   12344: 
                   12345: sub archive_row {
                   12346:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   12347:     my ($name) = ($item =~ m{([^/]+)$});
                   12348:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  12349:                                        'display'    => 'Add as file',
1.1055    raeburn  12350:                                        'dependency' => 'Include as dependency',
                   12351:                                        'discard'    => 'Discard',
                   12352:                                       );
                   12353:     if ($is_dir) {
1.1059    raeburn  12354:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  12355:     }
1.1056    raeburn  12356:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   12357:     my $offset = 0;
1.1055    raeburn  12358:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  12359:         $offset ++;
1.1065    raeburn  12360:         if ($action ne 'display') {
                   12361:             $offset ++;
                   12362:         }  
1.1055    raeburn  12363:         $output .= '<td><span class="LC_nobreak">'.
                   12364:                    '<label><input type="radio" name="archive_'.$count.
                   12365:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   12366:         my $text = $choices{$action};
                   12367:         if ($is_dir) {
                   12368:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   12369:             if ($action eq 'display') {
1.1059    raeburn  12370:                 $text = &mt('Add as folder');
1.1055    raeburn  12371:             }
1.1056    raeburn  12372:         } else {
                   12373:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   12374: 
                   12375:         }
                   12376:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   12377:         if ($action eq 'dependency') {
                   12378:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   12379:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   12380:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   12381:                        '<option value=""></option>'."\n".
                   12382:                        '</select>'."\n".
                   12383:                        '</div>';
1.1059    raeburn  12384:         } elsif ($action eq 'display') {
                   12385:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   12386:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   12387:                        '</div>';
1.1055    raeburn  12388:         }
1.1056    raeburn  12389:         $output .= '</td>';
1.1055    raeburn  12390:     }
                   12391:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   12392:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   12393:     for (my $i=0; $i<$depth; $i++) {
                   12394:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   12395:     }
                   12396:     if ($is_dir) {
                   12397:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   12398:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   12399:     } else {
                   12400:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   12401:     }
                   12402:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   12403:                &end_data_table_row();
                   12404:     return $output;
                   12405: }
                   12406: 
                   12407: sub archive_options_form {
1.1065    raeburn  12408:     my ($form,$display,$count,$hiddenelem) = @_;
                   12409:     my %lt = &Apache::lonlocal::texthash(
                   12410:                perm => 'Permanently remove archive file?',
                   12411:                hows => 'How should each extracted item be incorporated in the course?',
                   12412:                cont => 'Content actions for all',
                   12413:                addf => 'Add as folder/file',
                   12414:                incd => 'Include as dependency for a displayed file',
                   12415:                disc => 'Discard',
                   12416:                no   => 'No',
                   12417:                yes  => 'Yes',
                   12418:                save => 'Save',
                   12419:     );
                   12420:     my $output = <<"END";
                   12421: <form name="$form" method="post" action="">
                   12422: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   12423: <label>
                   12424:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   12425: </label>
                   12426: &nbsp;
                   12427: <label>
                   12428:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   12429: </span>
                   12430: </p>
                   12431: <input type="hidden" name="phase" value="decompress_cleanup" />
                   12432: <br />$lt{'hows'}
                   12433: <div class="LC_columnSection">
                   12434:   <fieldset>
                   12435:     <legend>$lt{'cont'}</legend>
                   12436:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   12437:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   12438:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   12439:   </fieldset>
                   12440: </div>
                   12441: END
                   12442:     return $output.
1.1055    raeburn  12443:            &start_data_table()."\n".
1.1065    raeburn  12444:            $display."\n".
1.1055    raeburn  12445:            &end_data_table()."\n".
                   12446:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   12447:            $hiddenelem.
1.1065    raeburn  12448:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  12449:            '</form>';
                   12450: }
                   12451: 
                   12452: sub archive_javascript {
1.1056    raeburn  12453:     my ($startcount,$numitems,$titles,$children) = @_;
                   12454:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  12455:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  12456:     my $scripttag = <<START;
                   12457: <script type="text/javascript">
                   12458: // <![CDATA[
                   12459: 
                   12460: function checkAll(form,prefix) {
                   12461:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   12462:     for (var i=0; i < form.elements.length; i++) {
                   12463:         var id = form.elements[i].id;
                   12464:         if ((id != '') && (id != undefined)) {
                   12465:             if (idstr.test(id)) {
                   12466:                 if (form.elements[i].type == 'radio') {
                   12467:                     form.elements[i].checked = true;
1.1056    raeburn  12468:                     var nostart = i-$startcount;
1.1059    raeburn  12469:                     var offset = nostart%7;
                   12470:                     var count = (nostart-offset)/7;    
1.1056    raeburn  12471:                     dependencyCheck(form,count,offset);
1.1055    raeburn  12472:                 }
                   12473:             }
                   12474:         }
                   12475:     }
                   12476: }
                   12477: 
                   12478: function propagateCheck(form,count) {
                   12479:     if (count > 0) {
1.1059    raeburn  12480:         var startelement = $startcount + ((count-1) * 7);
                   12481:         for (var j=1; j<6; j++) {
                   12482:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  12483:                 var item = startelement + j; 
                   12484:                 if (form.elements[item].type == 'radio') {
                   12485:                     if (form.elements[item].checked) {
                   12486:                         containerCheck(form,count,j);
                   12487:                         break;
                   12488:                     }
1.1055    raeburn  12489:                 }
                   12490:             }
                   12491:         }
                   12492:     }
                   12493: }
                   12494: 
                   12495: numitems = $numitems
1.1056    raeburn  12496: var titles = new Array(numitems);
                   12497: var parents = new Array(numitems);
1.1055    raeburn  12498: for (var i=0; i<numitems; i++) {
1.1056    raeburn  12499:     parents[i] = new Array;
1.1055    raeburn  12500: }
1.1059    raeburn  12501: var maintitle = '$maintitle';
1.1055    raeburn  12502: 
                   12503: START
                   12504: 
1.1056    raeburn  12505:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   12506:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  12507:         for (my $i=0; $i<@contents; $i ++) {
                   12508:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   12509:         }
                   12510:     }
                   12511: 
1.1056    raeburn  12512:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   12513:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   12514:     }
                   12515: 
1.1055    raeburn  12516:     $scripttag .= <<END;
                   12517: 
                   12518: function containerCheck(form,count,offset) {
                   12519:     if (count > 0) {
1.1056    raeburn  12520:         dependencyCheck(form,count,offset);
1.1059    raeburn  12521:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  12522:         form.elements[item].checked = true;
                   12523:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12524:             if (parents[count].length > 0) {
                   12525:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  12526:                     containerCheck(form,parents[count][j],offset);
                   12527:                 }
                   12528:             }
                   12529:         }
                   12530:     }
                   12531: }
                   12532: 
                   12533: function dependencyCheck(form,count,offset) {
                   12534:     if (count > 0) {
1.1059    raeburn  12535:         var chosen = (offset+$startcount)+7*(count-1);
                   12536:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  12537:         var currtype = form.elements[depitem].type;
                   12538:         if (form.elements[chosen].value == 'dependency') {
                   12539:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   12540:             form.elements[depitem].options.length = 0;
                   12541:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  12542:             for (var i=1; i<=numitems; i++) {
                   12543:                 if (i == count) {
                   12544:                     continue;
                   12545:                 }
1.1059    raeburn  12546:                 var startelement = $startcount + (i-1) * 7;
                   12547:                 for (var j=1; j<6; j++) {
                   12548:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  12549:                         var item = startelement + j;
                   12550:                         if (form.elements[item].type == 'radio') {
                   12551:                             if (form.elements[item].checked) {
                   12552:                                 if (form.elements[item].value == 'display') {
                   12553:                                     var n = form.elements[depitem].options.length;
                   12554:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   12555:                                 }
                   12556:                             }
                   12557:                         }
                   12558:                     }
                   12559:                 }
                   12560:             }
                   12561:         } else {
                   12562:             document.getElementById('arc_depon_'+count).style.display='none';
                   12563:             form.elements[depitem].options.length = 0;
                   12564:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   12565:         }
1.1059    raeburn  12566:         titleCheck(form,count,offset);
1.1056    raeburn  12567:     }
                   12568: }
                   12569: 
                   12570: function propagateSelect(form,count,offset) {
                   12571:     if (count > 0) {
1.1065    raeburn  12572:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  12573:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   12574:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12575:             if (parents[count].length > 0) {
                   12576:                 for (var j=0; j<parents[count].length; j++) {
                   12577:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  12578:                 }
                   12579:             }
                   12580:         }
                   12581:     }
                   12582: }
1.1056    raeburn  12583: 
                   12584: function containerSelect(form,count,offset,picked) {
                   12585:     if (count > 0) {
1.1065    raeburn  12586:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  12587:         if (form.elements[item].type == 'radio') {
                   12588:             if (form.elements[item].value == 'dependency') {
                   12589:                 if (form.elements[item+1].type == 'select-one') {
                   12590:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   12591:                         if (form.elements[item+1].options[i].value == picked) {
                   12592:                             form.elements[item+1].selectedIndex = i;
                   12593:                             break;
                   12594:                         }
                   12595:                     }
                   12596:                 }
                   12597:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12598:                     if (parents[count].length > 0) {
                   12599:                         for (var j=0; j<parents[count].length; j++) {
                   12600:                             containerSelect(form,parents[count][j],offset,picked);
                   12601:                         }
                   12602:                     }
                   12603:                 }
                   12604:             }
                   12605:         }
                   12606:     }
                   12607: }
                   12608: 
1.1059    raeburn  12609: function titleCheck(form,count,offset) {
                   12610:     if (count > 0) {
                   12611:         var chosen = (offset+$startcount)+7*(count-1);
                   12612:         var depitem = $startcount + ((count-1) * 7) + 2;
                   12613:         var currtype = form.elements[depitem].type;
                   12614:         if (form.elements[chosen].value == 'display') {
                   12615:             document.getElementById('arc_title_'+count).style.display='block';
                   12616:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   12617:                 document.getElementById('archive_title_'+count).value=maintitle;
                   12618:             }
                   12619:         } else {
                   12620:             document.getElementById('arc_title_'+count).style.display='none';
                   12621:             if (currtype == 'text') { 
                   12622:                 document.getElementById('archive_title_'+count).value='';
                   12623:             }
                   12624:         }
                   12625:     }
                   12626:     return;
                   12627: }
                   12628: 
1.1055    raeburn  12629: // ]]>
                   12630: </script>
                   12631: END
                   12632:     return $scripttag;
                   12633: }
                   12634: 
                   12635: sub process_extracted_files {
1.1067    raeburn  12636:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  12637:     my $numitems = $env{'form.archive_count'};
                   12638:     return unless ($numitems);
                   12639:     my @ids=&Apache::lonnet::current_machine_ids();
                   12640:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  12641:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  12642:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12643:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12644:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   12645:         $pathtocheck = "$dir_root/$destination";
                   12646:         $dir = $dir_root;
                   12647:         $ishome = 1;
                   12648:     } else {
                   12649:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   12650:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   12651:         $dir = "$dir_root/$docudom/$docuname";    
                   12652:     }
                   12653:     my $currdir = "$dir_root/$destination";
                   12654:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   12655:     if ($env{'form.folderpath'}) {
                   12656:         my @items = split('&',$env{'form.folderpath'});
                   12657:         $folders{'0'} = $items[-2];
1.1099    raeburn  12658:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   12659:             $containers{'0'}='page';
                   12660:         } else {  
                   12661:             $containers{'0'}='sequence';
                   12662:         }
1.1055    raeburn  12663:     }
                   12664:     my @archdirs = &get_env_multiple('form.archive_directory');
                   12665:     if ($numitems) {
                   12666:         for (my $i=1; $i<=$numitems; $i++) {
                   12667:             my $path = $env{'form.archive_content_'.$i};
                   12668:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   12669:                 my $item = $1;
                   12670:                 $toplevelitems{$item} = $i;
                   12671:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   12672:                     $is_dir{$item} = 1;
                   12673:                 }
                   12674:             }
                   12675:         }
                   12676:     }
1.1067    raeburn  12677:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  12678:     if (keys(%toplevelitems) > 0) {
                   12679:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  12680:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   12681:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  12682:     }
1.1066    raeburn  12683:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  12684:     if ($numitems) {
                   12685:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  12686:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  12687:             my $path = $env{'form.archive_content_'.$i};
                   12688:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12689:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   12690:                     if ($prefix ne '' && $path ne '') {
                   12691:                         if (-e $prefix.$path) {
1.1066    raeburn  12692:                             if ((@archdirs > 0) && 
                   12693:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   12694:                                 $todeletedir{$prefix.$path} = 1;
                   12695:                             } else {
                   12696:                                 $todelete{$prefix.$path} = 1;
                   12697:                             }
1.1055    raeburn  12698:                         }
                   12699:                     }
                   12700:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  12701:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  12702:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  12703:                     $docstitle = $env{'form.archive_title_'.$i};
                   12704:                     if ($docstitle eq '') {
                   12705:                         $docstitle = $title;
                   12706:                     }
1.1055    raeburn  12707:                     $outer = 0;
1.1056    raeburn  12708:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12709:                         if (@{$dirorder{$i}} > 0) {
                   12710:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  12711:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   12712:                                     $outer = $item;
                   12713:                                     last;
                   12714:                                 }
                   12715:                             }
                   12716:                         }
                   12717:                     }
                   12718:                     my ($errtext,$fatal) = 
                   12719:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   12720:                                                '/'.$folders{$outer}.'.'.
                   12721:                                                $containers{$outer});
                   12722:                     next if ($fatal);
                   12723:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   12724:                         if ($context eq 'coursedocs') {
1.1056    raeburn  12725:                             $mapinner{$i} = time;
1.1055    raeburn  12726:                             $folders{$i} = 'default_'.$mapinner{$i};
                   12727:                             $containers{$i} = 'sequence';
                   12728:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12729:                                       $folders{$i}.'.'.$containers{$i};
                   12730:                             my $newidx = &LONCAPA::map::getresidx();
                   12731:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12732:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12733:                             push(@LONCAPA::map::order,$newidx);
                   12734:                             my ($outtext,$errtext) =
                   12735:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12736:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12737:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  12738:                             $newseqid{$i} = $newidx;
1.1067    raeburn  12739:                             unless ($errtext) {
                   12740:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   12741:                             }
1.1055    raeburn  12742:                         }
                   12743:                     } else {
                   12744:                         if ($context eq 'coursedocs') {
                   12745:                             my $newidx=&LONCAPA::map::getresidx();
                   12746:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12747:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   12748:                                       $title;
                   12749:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   12750:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   12751:                             }
                   12752:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12753:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12754:                             }
                   12755:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12756:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  12757:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  12758:                                 unless ($ishome) {
                   12759:                                     my $fetch = "$newdest{$i}/$title";
                   12760:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12761:                                     $prompttofetch{$fetch} = 1;
                   12762:                                 }
1.1055    raeburn  12763:                             }
                   12764:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12765:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12766:                             push(@LONCAPA::map::order, $newidx);
                   12767:                             my ($outtext,$errtext)=
                   12768:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12769:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12770:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  12771:                             unless ($errtext) {
                   12772:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12773:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   12774:                                 }
                   12775:                             }
1.1055    raeburn  12776:                         }
                   12777:                     }
1.1086    raeburn  12778:                 }
                   12779:             } else {
                   12780:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12781:             }
                   12782:         }
                   12783:         for (my $i=1; $i<=$numitems; $i++) {
                   12784:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12785:             my $path = $env{'form.archive_content_'.$i};
                   12786:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12787:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12788:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12789:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12790:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12791:                         my ($itemidx,$fullpath,$relpath);
                   12792:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12793:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12794:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  12795:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12796:                                     $itemidx = $j;
1.1056    raeburn  12797:                                 }
                   12798:                             }
1.1086    raeburn  12799:                         }
                   12800:                         if ($itemidx eq '') {
                   12801:                             $itemidx =  0;
                   12802:                         } 
                   12803:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12804:                             if ($mapinner{$referrer{$i}}) {
                   12805:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12806:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12807:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12808:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12809:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12810:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12811:                                             if (!-e $fullpath) {
                   12812:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12813:                                             }
                   12814:                                         }
1.1086    raeburn  12815:                                     } else {
                   12816:                                         last;
1.1056    raeburn  12817:                                     }
1.1086    raeburn  12818:                                 }
                   12819:                             }
                   12820:                         } elsif ($newdest{$referrer{$i}}) {
                   12821:                             $fullpath = $newdest{$referrer{$i}};
                   12822:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12823:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12824:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12825:                                     last;
                   12826:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12827:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12828:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12829:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12830:                                         if (!-e $fullpath) {
                   12831:                                             mkdir($fullpath,0755);
1.1056    raeburn  12832:                                         }
                   12833:                                     }
1.1086    raeburn  12834:                                 } else {
                   12835:                                     last;
1.1056    raeburn  12836:                                 }
1.1055    raeburn  12837:                             }
                   12838:                         }
1.1086    raeburn  12839:                         if ($fullpath ne '') {
                   12840:                             if (-e "$prefix$path") {
                   12841:                                 system("mv $prefix$path $fullpath/$title");
                   12842:                             }
                   12843:                             if (-e "$fullpath/$title") {
                   12844:                                 my $showpath;
                   12845:                                 if ($relpath ne '') {
                   12846:                                     $showpath = "$relpath/$title";
                   12847:                                 } else {
                   12848:                                     $showpath = "/$title";
                   12849:                                 } 
                   12850:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12851:                             } 
                   12852:                             unless ($ishome) {
                   12853:                                 my $fetch = "$fullpath/$title";
                   12854:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   12855:                                 $prompttofetch{$fetch} = 1;
                   12856:                             }
                   12857:                         }
1.1055    raeburn  12858:                     }
1.1086    raeburn  12859:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12860:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12861:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12862:                 }
                   12863:             } else {
                   12864:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12865:             }
                   12866:         }
                   12867:         if (keys(%todelete)) {
                   12868:             foreach my $key (keys(%todelete)) {
                   12869:                 unlink($key);
1.1066    raeburn  12870:             }
                   12871:         }
                   12872:         if (keys(%todeletedir)) {
                   12873:             foreach my $key (keys(%todeletedir)) {
                   12874:                 rmdir($key);
                   12875:             }
                   12876:         }
                   12877:         foreach my $dir (sort(keys(%is_dir))) {
                   12878:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12879:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12880:             }
                   12881:         }
1.1067    raeburn  12882:         if ($result ne '') {
                   12883:             $output .= '<ul>'."\n".
                   12884:                        $result."\n".
                   12885:                        '</ul>';
                   12886:         }
                   12887:         unless ($ishome) {
                   12888:             my $replicationfail;
                   12889:             foreach my $item (keys(%prompttofetch)) {
                   12890:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12891:                 unless ($fetchresult eq 'ok') {
                   12892:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12893:                 }
                   12894:             }
                   12895:             if ($replicationfail) {
                   12896:                 $output .= '<p class="LC_error">'.
                   12897:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12898:                            $replicationfail.
                   12899:                            '</ul></p>';
                   12900:             }
                   12901:         }
1.1055    raeburn  12902:     } else {
                   12903:         $warning = &mt('No items found in archive.');
                   12904:     }
                   12905:     if ($error) {
                   12906:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12907:                    $error.'</p>'."\n";
                   12908:     }
                   12909:     if ($warning) {
                   12910:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12911:     }
                   12912:     return $output;
                   12913: }
                   12914: 
1.1066    raeburn  12915: sub cleanup_empty_dirs {
                   12916:     my ($path) = @_;
                   12917:     if (($path ne '') && (-d $path)) {
                   12918:         if (opendir(my $dirh,$path)) {
                   12919:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12920:             my $numitems = 0;
                   12921:             foreach my $item (@dircontents) {
                   12922:                 if (-d "$path/$item") {
1.1111    raeburn  12923:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12924:                     if (-e "$path/$item") {
                   12925:                         $numitems ++;
                   12926:                     }
                   12927:                 } else {
                   12928:                     $numitems ++;
                   12929:                 }
                   12930:             }
                   12931:             if ($numitems == 0) {
                   12932:                 rmdir($path);
                   12933:             }
                   12934:             closedir($dirh);
                   12935:         }
                   12936:     }
                   12937:     return;
                   12938: }
                   12939: 
1.41      ng       12940: =pod
1.45      matthew  12941: 
1.1162    raeburn  12942: =item * &get_folder_hierarchy()
1.1068    raeburn  12943: 
                   12944: Provides hierarchy of names of folders/sub-folders containing the current
                   12945: item,
                   12946: 
                   12947: Inputs: 3
                   12948:      - $navmap - navmaps object
                   12949: 
                   12950:      - $map - url for map (either the trigger itself, or map containing
                   12951:                            the resource, which is the trigger).
                   12952: 
                   12953:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12954: 
                   12955: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12956: 
                   12957: =cut
                   12958: 
                   12959: sub get_folder_hierarchy {
                   12960:     my ($navmap,$map,$showitem) = @_;
                   12961:     my @pathitems;
                   12962:     if (ref($navmap)) {
                   12963:         my $mapres = $navmap->getResourceByUrl($map);
                   12964:         if (ref($mapres)) {
                   12965:             my $pcslist = $mapres->map_hierarchy();
                   12966:             if ($pcslist ne '') {
                   12967:                 my @pcs = split(/,/,$pcslist);
                   12968:                 foreach my $pc (@pcs) {
                   12969:                     if ($pc == 1) {
1.1129    raeburn  12970:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12971:                     } else {
                   12972:                         my $res = $navmap->getByMapPc($pc);
                   12973:                         if (ref($res)) {
                   12974:                             my $title = $res->compTitle();
                   12975:                             $title =~ s/\W+/_/g;
                   12976:                             if ($title ne '') {
                   12977:                                 push(@pathitems,$title);
                   12978:                             }
                   12979:                         }
                   12980:                     }
                   12981:                 }
                   12982:             }
1.1071    raeburn  12983:             if ($showitem) {
                   12984:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12985:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12986:                 } else {
                   12987:                     my $maptitle = $mapres->compTitle();
                   12988:                     $maptitle =~ s/\W+/_/g;
                   12989:                     if ($maptitle ne '') {
                   12990:                         push(@pathitems,$maptitle);
                   12991:                     }
1.1068    raeburn  12992:                 }
                   12993:             }
                   12994:         }
                   12995:     }
                   12996:     return @pathitems;
                   12997: }
                   12998: 
                   12999: =pod
                   13000: 
1.1015    raeburn  13001: =item * &get_turnedin_filepath()
                   13002: 
                   13003: Determines path in a user's portfolio file for storage of files uploaded
                   13004: to a specific essayresponse or dropbox item.
                   13005: 
                   13006: Inputs: 3 required + 1 optional.
                   13007: $symb is symb for resource, $uname and $udom are for current user (required).
                   13008: $caller is optional (can be "submission", if routine is called when storing
                   13009: an upoaded file when "Submit Answer" button was pressed).
                   13010: 
                   13011: Returns array containing $path and $multiresp. 
                   13012: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   13013: than one file upload item.  Callers of routine should append partid as a 
                   13014: subdirectory to $path in cases where $multiresp is 1.
                   13015: 
                   13016: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   13017: 
                   13018: =cut
                   13019: 
                   13020: sub get_turnedin_filepath {
                   13021:     my ($symb,$uname,$udom,$caller) = @_;
                   13022:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   13023:     my $turnindir;
                   13024:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   13025:     $turnindir = $userhash{'turnindir'};
                   13026:     my ($path,$multiresp);
                   13027:     if ($turnindir eq '') {
                   13028:         if ($caller eq 'submission') {
                   13029:             $turnindir = &mt('turned in');
                   13030:             $turnindir =~ s/\W+/_/g;
                   13031:             my %newhash = (
                   13032:                             'turnindir' => $turnindir,
                   13033:                           );
                   13034:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   13035:         }
                   13036:     }
                   13037:     if ($turnindir ne '') {
                   13038:         $path = '/'.$turnindir.'/';
                   13039:         my ($multipart,$turnin,@pathitems);
                   13040:         my $navmap = Apache::lonnavmaps::navmap->new();
                   13041:         if (defined($navmap)) {
                   13042:             my $mapres = $navmap->getResourceByUrl($map);
                   13043:             if (ref($mapres)) {
                   13044:                 my $pcslist = $mapres->map_hierarchy();
                   13045:                 if ($pcslist ne '') {
                   13046:                     foreach my $pc (split(/,/,$pcslist)) {
                   13047:                         my $res = $navmap->getByMapPc($pc);
                   13048:                         if (ref($res)) {
                   13049:                             my $title = $res->compTitle();
                   13050:                             $title =~ s/\W+/_/g;
                   13051:                             if ($title ne '') {
1.1149    raeburn  13052:                                 if (($pc > 1) && (length($title) > 12)) {
                   13053:                                     $title = substr($title,0,12);
                   13054:                                 }
1.1015    raeburn  13055:                                 push(@pathitems,$title);
                   13056:                             }
                   13057:                         }
                   13058:                     }
                   13059:                 }
                   13060:                 my $maptitle = $mapres->compTitle();
                   13061:                 $maptitle =~ s/\W+/_/g;
                   13062:                 if ($maptitle ne '') {
1.1149    raeburn  13063:                     if (length($maptitle) > 12) {
                   13064:                         $maptitle = substr($maptitle,0,12);
                   13065:                     }
1.1015    raeburn  13066:                     push(@pathitems,$maptitle);
                   13067:                 }
                   13068:                 unless ($env{'request.state'} eq 'construct') {
                   13069:                     my $res = $navmap->getBySymb($symb);
                   13070:                     if (ref($res)) {
                   13071:                         my $partlist = $res->parts();
                   13072:                         my $totaluploads = 0;
                   13073:                         if (ref($partlist) eq 'ARRAY') {
                   13074:                             foreach my $part (@{$partlist}) {
                   13075:                                 my @types = $res->responseType($part);
                   13076:                                 my @ids = $res->responseIds($part);
                   13077:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   13078:                                     if ($types[$i] eq 'essay') {
                   13079:                                         my $partid = $part.'_'.$ids[$i];
                   13080:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   13081:                                             $totaluploads ++;
                   13082:                                         }
                   13083:                                     }
                   13084:                                 }
                   13085:                             }
                   13086:                             if ($totaluploads > 1) {
                   13087:                                 $multiresp = 1;
                   13088:                             }
                   13089:                         }
                   13090:                     }
                   13091:                 }
                   13092:             } else {
                   13093:                 return;
                   13094:             }
                   13095:         } else {
                   13096:             return;
                   13097:         }
                   13098:         my $restitle=&Apache::lonnet::gettitle($symb);
                   13099:         $restitle =~ s/\W+/_/g;
                   13100:         if ($restitle eq '') {
                   13101:             $restitle = ($resurl =~ m{/[^/]+$});
                   13102:             if ($restitle eq '') {
                   13103:                 $restitle = time;
                   13104:             }
                   13105:         }
1.1149    raeburn  13106:         if (length($restitle) > 12) {
                   13107:             $restitle = substr($restitle,0,12);
                   13108:         }
1.1015    raeburn  13109:         push(@pathitems,$restitle);
                   13110:         $path .= join('/',@pathitems);
                   13111:     }
                   13112:     return ($path,$multiresp);
                   13113: }
                   13114: 
                   13115: =pod
                   13116: 
1.464     albertel 13117: =back
1.41      ng       13118: 
1.112     bowersj2 13119: =head1 CSV Upload/Handling functions
1.38      albertel 13120: 
1.41      ng       13121: =over 4
                   13122: 
1.648     raeburn  13123: =item * &upfile_store($r)
1.41      ng       13124: 
                   13125: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 13126: needs $env{'form.upfile'}
1.41      ng       13127: returns $datatoken to be put into hidden field
                   13128: 
                   13129: =cut
1.31      albertel 13130: 
                   13131: sub upfile_store {
                   13132:     my $r=shift;
1.258     albertel 13133:     $env{'form.upfile'}=~s/\r/\n/gs;
                   13134:     $env{'form.upfile'}=~s/\f/\n/gs;
                   13135:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   13136:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 13137: 
1.258     albertel 13138:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   13139: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 13140:     {
1.158     raeburn  13141:         my $datafile = $r->dir_config('lonDaemons').
                   13142:                            '/tmp/'.$datatoken.'.tmp';
                   13143:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 13144:             print $fh $env{'form.upfile'};
1.158     raeburn  13145:             close($fh);
                   13146:         }
1.31      albertel 13147:     }
                   13148:     return $datatoken;
                   13149: }
                   13150: 
1.56      matthew  13151: =pod
                   13152: 
1.648     raeburn  13153: =item * &load_tmp_file($r)
1.41      ng       13154: 
                   13155: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 13156: needs $env{'form.datatoken'},
                   13157: sets $env{'form.upfile'} to the contents of the file
1.41      ng       13158: 
                   13159: =cut
1.31      albertel 13160: 
                   13161: sub load_tmp_file {
                   13162:     my $r=shift;
                   13163:     my @studentdata=();
                   13164:     {
1.158     raeburn  13165:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 13166:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  13167:         if ( open(my $fh,"<$studentfile") ) {
                   13168:             @studentdata=<$fh>;
                   13169:             close($fh);
                   13170:         }
1.31      albertel 13171:     }
1.258     albertel 13172:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 13173: }
                   13174: 
1.56      matthew  13175: =pod
                   13176: 
1.648     raeburn  13177: =item * &upfile_record_sep()
1.41      ng       13178: 
                   13179: Separate uploaded file into records
                   13180: returns array of records,
1.258     albertel 13181: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       13182: 
                   13183: =cut
1.31      albertel 13184: 
                   13185: sub upfile_record_sep {
1.258     albertel 13186:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 13187:     } else {
1.248     albertel 13188: 	my @records;
1.258     albertel 13189: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 13190: 	    if ($line=~/^\s*$/) { next; }
                   13191: 	    push(@records,$line);
                   13192: 	}
                   13193: 	return @records;
1.31      albertel 13194:     }
                   13195: }
                   13196: 
1.56      matthew  13197: =pod
                   13198: 
1.648     raeburn  13199: =item * &record_sep($record)
1.41      ng       13200: 
1.258     albertel 13201: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       13202: 
                   13203: =cut
                   13204: 
1.263     www      13205: sub takeleft {
                   13206:     my $index=shift;
                   13207:     return substr('0000'.$index,-4,4);
                   13208: }
                   13209: 
1.31      albertel 13210: sub record_sep {
                   13211:     my $record=shift;
                   13212:     my %components=();
1.258     albertel 13213:     if ($env{'form.upfiletype'} eq 'xml') {
                   13214:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 13215:         my $i=0;
1.356     albertel 13216:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 13217:             $field=~s/^(\"|\')//;
                   13218:             $field=~s/(\"|\')$//;
1.263     www      13219:             $components{&takeleft($i)}=$field;
1.31      albertel 13220:             $i++;
                   13221:         }
1.258     albertel 13222:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 13223:         my $i=0;
1.356     albertel 13224:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 13225:             $field=~s/^(\"|\')//;
                   13226:             $field=~s/(\"|\')$//;
1.263     www      13227:             $components{&takeleft($i)}=$field;
1.31      albertel 13228:             $i++;
                   13229:         }
                   13230:     } else {
1.561     www      13231:         my $separator=',';
1.480     banghart 13232:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      13233:             $separator=';';
1.480     banghart 13234:         }
1.31      albertel 13235:         my $i=0;
1.561     www      13236: # the character we are looking for to indicate the end of a quote or a record 
                   13237:         my $looking_for=$separator;
                   13238: # do not add the characters to the fields
                   13239:         my $ignore=0;
                   13240: # we just encountered a separator (or the beginning of the record)
                   13241:         my $just_found_separator=1;
                   13242: # store the field we are working on here
                   13243:         my $field='';
                   13244: # work our way through all characters in record
                   13245:         foreach my $character ($record=~/(.)/g) {
                   13246:             if ($character eq $looking_for) {
                   13247:                if ($character ne $separator) {
                   13248: # Found the end of a quote, again looking for separator
                   13249:                   $looking_for=$separator;
                   13250:                   $ignore=1;
                   13251:                } else {
                   13252: # Found a separator, store away what we got
                   13253:                   $components{&takeleft($i)}=$field;
                   13254: 	          $i++;
                   13255:                   $just_found_separator=1;
                   13256:                   $ignore=0;
                   13257:                   $field='';
                   13258:                }
                   13259:                next;
                   13260:             }
                   13261: # single or double quotation marks after a separator indicate beginning of a quote
                   13262: # we are now looking for the end of the quote and need to ignore separators
                   13263:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   13264:                $looking_for=$character;
                   13265:                next;
                   13266:             }
                   13267: # ignore would be true after we reached the end of a quote
                   13268:             if ($ignore) { next; }
                   13269:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   13270:             $field.=$character;
                   13271:             $just_found_separator=0; 
1.31      albertel 13272:         }
1.561     www      13273: # catch the very last entry, since we never encountered the separator
                   13274:         $components{&takeleft($i)}=$field;
1.31      albertel 13275:     }
                   13276:     return %components;
                   13277: }
                   13278: 
1.144     matthew  13279: ######################################################
                   13280: ######################################################
                   13281: 
1.56      matthew  13282: =pod
                   13283: 
1.648     raeburn  13284: =item * &upfile_select_html()
1.41      ng       13285: 
1.144     matthew  13286: Return HTML code to select a file from the users machine and specify 
                   13287: the file type.
1.41      ng       13288: 
                   13289: =cut
                   13290: 
1.144     matthew  13291: ######################################################
                   13292: ######################################################
1.31      albertel 13293: sub upfile_select_html {
1.144     matthew  13294:     my %Types = (
                   13295:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 13296:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  13297:                  space => &mt('Space separated'),
                   13298:                  tab   => &mt('Tabulator separated'),
                   13299: #                 xml   => &mt('HTML/XML'),
                   13300:                  );
                   13301:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  13302:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  13303:     foreach my $type (sort(keys(%Types))) {
                   13304:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   13305:     }
                   13306:     $Str .= "</select>\n";
                   13307:     return $Str;
1.31      albertel 13308: }
                   13309: 
1.301     albertel 13310: sub get_samples {
                   13311:     my ($records,$toget) = @_;
                   13312:     my @samples=({});
                   13313:     my $got=0;
                   13314:     foreach my $rec (@$records) {
                   13315: 	my %temp = &record_sep($rec);
                   13316: 	if (! grep(/\S/, values(%temp))) { next; }
                   13317: 	if (%temp) {
                   13318: 	    $samples[$got]=\%temp;
                   13319: 	    $got++;
                   13320: 	    if ($got == $toget) { last; }
                   13321: 	}
                   13322:     }
                   13323:     return \@samples;
                   13324: }
                   13325: 
1.144     matthew  13326: ######################################################
                   13327: ######################################################
                   13328: 
1.56      matthew  13329: =pod
                   13330: 
1.648     raeburn  13331: =item * &csv_print_samples($r,$records)
1.41      ng       13332: 
                   13333: Prints a table of sample values from each column uploaded $r is an
                   13334: Apache Request ref, $records is an arrayref from
                   13335: &Apache::loncommon::upfile_record_sep
                   13336: 
                   13337: =cut
                   13338: 
1.144     matthew  13339: ######################################################
                   13340: ######################################################
1.31      albertel 13341: sub csv_print_samples {
                   13342:     my ($r,$records) = @_;
1.662     bisitz   13343:     my $samples = &get_samples($records,5);
1.301     albertel 13344: 
1.594     raeburn  13345:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   13346:               &start_data_table_header_row());
1.356     albertel 13347:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   13348:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  13349:     $r->print(&end_data_table_header_row());
1.301     albertel 13350:     foreach my $hash (@$samples) {
1.594     raeburn  13351: 	$r->print(&start_data_table_row());
1.356     albertel 13352: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 13353: 	    $r->print('<td>');
1.356     albertel 13354: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 13355: 	    $r->print('</td>');
                   13356: 	}
1.594     raeburn  13357: 	$r->print(&end_data_table_row());
1.31      albertel 13358:     }
1.594     raeburn  13359:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 13360: }
                   13361: 
1.144     matthew  13362: ######################################################
                   13363: ######################################################
                   13364: 
1.56      matthew  13365: =pod
                   13366: 
1.648     raeburn  13367: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       13368: 
                   13369: Prints a table to create associations between values and table columns.
1.144     matthew  13370: 
1.41      ng       13371: $r is an Apache Request ref,
                   13372: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  13373: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       13374: 
                   13375: =cut
                   13376: 
1.144     matthew  13377: ######################################################
                   13378: ######################################################
1.31      albertel 13379: sub csv_print_select_table {
                   13380:     my ($r,$records,$d) = @_;
1.301     albertel 13381:     my $i=0;
                   13382:     my $samples = &get_samples($records,1);
1.144     matthew  13383:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  13384: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  13385:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  13386:               '<th>'.&mt('Column').'</th>'.
                   13387:               &end_data_table_header_row()."\n");
1.356     albertel 13388:     foreach my $array_ref (@$d) {
                   13389: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  13390: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 13391: 
1.875     bisitz   13392: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  13393: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 13394: 	$r->print('<option value="none"></option>');
1.356     albertel 13395: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   13396: 	    $r->print('<option value="'.$sample.'"'.
                   13397:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   13398:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 13399: 	}
1.594     raeburn  13400: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 13401: 	$i++;
                   13402:     }
1.594     raeburn  13403:     $r->print(&end_data_table());
1.31      albertel 13404:     $i--;
                   13405:     return $i;
                   13406: }
1.56      matthew  13407: 
1.144     matthew  13408: ######################################################
                   13409: ######################################################
                   13410: 
1.56      matthew  13411: =pod
1.31      albertel 13412: 
1.648     raeburn  13413: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       13414: 
                   13415: Prints a table of sample values from the upload and can make associate samples to internal names.
                   13416: 
                   13417: $r is an Apache Request ref,
                   13418: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   13419: $d is an array of 2 element arrays (internal name, displayed name)
                   13420: 
                   13421: =cut
                   13422: 
1.144     matthew  13423: ######################################################
                   13424: ######################################################
1.31      albertel 13425: sub csv_samples_select_table {
                   13426:     my ($r,$records,$d) = @_;
                   13427:     my $i=0;
1.144     matthew  13428:     #
1.662     bisitz   13429:     my $max_samples = 5;
                   13430:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  13431:     $r->print(&start_data_table().
                   13432:               &start_data_table_header_row().'<th>'.
                   13433:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   13434:               &end_data_table_header_row());
1.301     albertel 13435: 
                   13436:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  13437: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  13438: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 13439: 	foreach my $option (@$d) {
                   13440: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  13441: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 13442:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  13443:                       $display.'</option>');
1.31      albertel 13444: 	}
                   13445: 	$r->print('</select></td><td>');
1.662     bisitz   13446: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 13447: 	    if (defined($samples->[$line]{$key})) { 
                   13448: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   13449: 	    }
                   13450: 	}
1.594     raeburn  13451: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 13452: 	$i++;
                   13453:     }
1.594     raeburn  13454:     $r->print(&end_data_table());
1.31      albertel 13455:     $i--;
                   13456:     return($i);
1.115     matthew  13457: }
                   13458: 
1.144     matthew  13459: ######################################################
                   13460: ######################################################
                   13461: 
1.115     matthew  13462: =pod
                   13463: 
1.648     raeburn  13464: =item * &clean_excel_name($name)
1.115     matthew  13465: 
                   13466: Returns a replacement for $name which does not contain any illegal characters.
                   13467: 
                   13468: =cut
                   13469: 
1.144     matthew  13470: ######################################################
                   13471: ######################################################
1.115     matthew  13472: sub clean_excel_name {
                   13473:     my ($name) = @_;
                   13474:     $name =~ s/[:\*\?\/\\]//g;
                   13475:     if (length($name) > 31) {
                   13476:         $name = substr($name,0,31);
                   13477:     }
                   13478:     return $name;
1.25      albertel 13479: }
1.84      albertel 13480: 
1.85      albertel 13481: =pod
                   13482: 
1.648     raeburn  13483: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 13484: 
                   13485: Returns either 1 or undef
                   13486: 
                   13487: 1 if the part is to be hidden, undef if it is to be shown
                   13488: 
                   13489: Arguments are:
                   13490: 
                   13491: $id the id of the part to be checked
                   13492: $symb, optional the symb of the resource to check
                   13493: $udom, optional the domain of the user to check for
                   13494: $uname, optional the username of the user to check for
                   13495: 
                   13496: =cut
1.84      albertel 13497: 
                   13498: sub check_if_partid_hidden {
                   13499:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 13500:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 13501: 					 $symb,$udom,$uname);
1.141     albertel 13502:     my $truth=1;
                   13503:     #if the string starts with !, then the list is the list to show not hide
                   13504:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 13505:     my @hiddenlist=split(/,/,$hiddenparts);
                   13506:     foreach my $checkid (@hiddenlist) {
1.141     albertel 13507: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 13508:     }
1.141     albertel 13509:     return !$truth;
1.84      albertel 13510: }
1.127     matthew  13511: 
1.138     matthew  13512: 
                   13513: ############################################################
                   13514: ############################################################
                   13515: 
                   13516: =pod
                   13517: 
1.157     matthew  13518: =back 
                   13519: 
1.138     matthew  13520: =head1 cgi-bin script and graphing routines
                   13521: 
1.157     matthew  13522: =over 4
                   13523: 
1.648     raeburn  13524: =item * &get_cgi_id()
1.138     matthew  13525: 
                   13526: Inputs: none
                   13527: 
                   13528: Returns an id which can be used to pass environment variables
                   13529: to various cgi-bin scripts.  These environment variables will
                   13530: be removed from the users environment after a given time by
                   13531: the routine &Apache::lonnet::transfer_profile_to_env.
                   13532: 
                   13533: =cut
                   13534: 
                   13535: ############################################################
                   13536: ############################################################
1.152     albertel 13537: my $uniq=0;
1.136     matthew  13538: sub get_cgi_id {
1.154     albertel 13539:     $uniq=($uniq+1)%100000;
1.280     albertel 13540:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  13541: }
                   13542: 
1.127     matthew  13543: ############################################################
                   13544: ############################################################
                   13545: 
                   13546: =pod
                   13547: 
1.648     raeburn  13548: =item * &DrawBarGraph()
1.127     matthew  13549: 
1.138     matthew  13550: Facilitates the plotting of data in a (stacked) bar graph.
                   13551: Puts plot definition data into the users environment in order for 
                   13552: graph.png to plot it.  Returns an <img> tag for the plot.
                   13553: The bars on the plot are labeled '1','2',...,'n'.
                   13554: 
                   13555: Inputs:
                   13556: 
                   13557: =over 4
                   13558: 
                   13559: =item $Title: string, the title of the plot
                   13560: 
                   13561: =item $xlabel: string, text describing the X-axis of the plot
                   13562: 
                   13563: =item $ylabel: string, text describing the Y-axis of the plot
                   13564: 
                   13565: =item $Max: scalar, the maximum Y value to use in the plot
                   13566: If $Max is < any data point, the graph will not be rendered.
                   13567: 
1.140     matthew  13568: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  13569: they are plotted.  If undefined, default values will be used.
                   13570: 
1.178     matthew  13571: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   13572: 
1.138     matthew  13573: =item @Values: An array of array references.  Each array reference holds data
                   13574: to be plotted in a stacked bar chart.
                   13575: 
1.239     matthew  13576: =item If the final element of @Values is a hash reference the key/value
                   13577: pairs will be added to the graph definition.
                   13578: 
1.138     matthew  13579: =back
                   13580: 
                   13581: Returns:
                   13582: 
                   13583: An <img> tag which references graph.png and the appropriate identifying
                   13584: information for the plot.
                   13585: 
1.127     matthew  13586: =cut
                   13587: 
                   13588: ############################################################
                   13589: ############################################################
1.134     matthew  13590: sub DrawBarGraph {
1.178     matthew  13591:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  13592:     #
                   13593:     if (! defined($colors)) {
                   13594:         $colors = ['#33ff00', 
                   13595:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   13596:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   13597:                   ]; 
                   13598:     }
1.228     matthew  13599:     my $extra_settings = {};
                   13600:     if (ref($Values[-1]) eq 'HASH') {
                   13601:         $extra_settings = pop(@Values);
                   13602:     }
1.127     matthew  13603:     #
1.136     matthew  13604:     my $identifier = &get_cgi_id();
                   13605:     my $id = 'cgi.'.$identifier;        
1.129     matthew  13606:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  13607:         return '';
                   13608:     }
1.225     matthew  13609:     #
                   13610:     my @Labels;
                   13611:     if (defined($labels)) {
                   13612:         @Labels = @$labels;
                   13613:     } else {
                   13614:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   13615:             push (@Labels,$i+1);
                   13616:         }
                   13617:     }
                   13618:     #
1.129     matthew  13619:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  13620:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  13621:     my %ValuesHash;
                   13622:     my $NumSets=1;
                   13623:     foreach my $array (@Values) {
                   13624:         next if (! ref($array));
1.136     matthew  13625:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  13626:             join(',',@$array);
1.129     matthew  13627:     }
1.127     matthew  13628:     #
1.136     matthew  13629:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  13630:     if ($NumBars < 3) {
                   13631:         $width = 120+$NumBars*32;
1.220     matthew  13632:         $xskip = 1;
1.225     matthew  13633:         $bar_width = 30;
                   13634:     } elsif ($NumBars < 5) {
                   13635:         $width = 120+$NumBars*20;
                   13636:         $xskip = 1;
                   13637:         $bar_width = 20;
1.220     matthew  13638:     } elsif ($NumBars < 10) {
1.136     matthew  13639:         $width = 120+$NumBars*15;
                   13640:         $xskip = 1;
                   13641:         $bar_width = 15;
                   13642:     } elsif ($NumBars <= 25) {
                   13643:         $width = 120+$NumBars*11;
                   13644:         $xskip = 5;
                   13645:         $bar_width = 8;
                   13646:     } elsif ($NumBars <= 50) {
                   13647:         $width = 120+$NumBars*8;
                   13648:         $xskip = 5;
                   13649:         $bar_width = 4;
                   13650:     } else {
                   13651:         $width = 120+$NumBars*8;
                   13652:         $xskip = 5;
                   13653:         $bar_width = 4;
                   13654:     }
                   13655:     #
1.137     matthew  13656:     $Max = 1 if ($Max < 1);
                   13657:     if ( int($Max) < $Max ) {
                   13658:         $Max++;
                   13659:         $Max = int($Max);
                   13660:     }
1.127     matthew  13661:     $Title  = '' if (! defined($Title));
                   13662:     $xlabel = '' if (! defined($xlabel));
                   13663:     $ylabel = '' if (! defined($ylabel));
1.369     www      13664:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   13665:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   13666:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  13667:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  13668:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   13669:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   13670:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   13671:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13672:     $ValuesHash{$id.'.height'}   = $height;
                   13673:     $ValuesHash{$id.'.width'}    = $width;
                   13674:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   13675:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   13676:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  13677:     #
1.228     matthew  13678:     # Deal with other parameters
                   13679:     while (my ($key,$value) = each(%$extra_settings)) {
                   13680:         $ValuesHash{$id.'.'.$key} = $value;
                   13681:     }
                   13682:     #
1.646     raeburn  13683:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  13684:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13685: }
                   13686: 
                   13687: ############################################################
                   13688: ############################################################
                   13689: 
                   13690: =pod
                   13691: 
1.648     raeburn  13692: =item * &DrawXYGraph()
1.137     matthew  13693: 
1.138     matthew  13694: Facilitates the plotting of data in an XY graph.
                   13695: Puts plot definition data into the users environment in order for 
                   13696: graph.png to plot it.  Returns an <img> tag for the plot.
                   13697: 
                   13698: Inputs:
                   13699: 
                   13700: =over 4
                   13701: 
                   13702: =item $Title: string, the title of the plot
                   13703: 
                   13704: =item $xlabel: string, text describing the X-axis of the plot
                   13705: 
                   13706: =item $ylabel: string, text describing the Y-axis of the plot
                   13707: 
                   13708: =item $Max: scalar, the maximum Y value to use in the plot
                   13709: If $Max is < any data point, the graph will not be rendered.
                   13710: 
                   13711: =item $colors: Array ref containing the hex color codes for the data to be 
                   13712: plotted in.  If undefined, default values will be used.
                   13713: 
                   13714: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13715: 
                   13716: =item $Ydata: Array ref containing Array refs.  
1.185     www      13717: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  13718: 
                   13719: =item %Values: hash indicating or overriding any default values which are 
                   13720: passed to graph.png.  
                   13721: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13722: 
                   13723: =back
                   13724: 
                   13725: Returns:
                   13726: 
                   13727: An <img> tag which references graph.png and the appropriate identifying
                   13728: information for the plot.
                   13729: 
1.137     matthew  13730: =cut
                   13731: 
                   13732: ############################################################
                   13733: ############################################################
                   13734: sub DrawXYGraph {
                   13735:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   13736:     #
                   13737:     # Create the identifier for the graph
                   13738:     my $identifier = &get_cgi_id();
                   13739:     my $id = 'cgi.'.$identifier;
                   13740:     #
                   13741:     $Title  = '' if (! defined($Title));
                   13742:     $xlabel = '' if (! defined($xlabel));
                   13743:     $ylabel = '' if (! defined($ylabel));
                   13744:     my %ValuesHash = 
                   13745:         (
1.369     www      13746:          $id.'.title'  => &escape($Title),
                   13747:          $id.'.xlabel' => &escape($xlabel),
                   13748:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  13749:          $id.'.y_max_value'=> $Max,
                   13750:          $id.'.labels'     => join(',',@$Xlabels),
                   13751:          $id.'.PlotType'   => 'XY',
                   13752:          );
                   13753:     #
                   13754:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13755:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13756:     }
                   13757:     #
                   13758:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13759:         return '';
                   13760:     }
                   13761:     my $NumSets=1;
1.138     matthew  13762:     foreach my $array (@{$Ydata}){
1.137     matthew  13763:         next if (! ref($array));
                   13764:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13765:     }
1.138     matthew  13766:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13767:     #
                   13768:     # Deal with other parameters
                   13769:     while (my ($key,$value) = each(%Values)) {
                   13770:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13771:     }
                   13772:     #
1.646     raeburn  13773:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13774:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13775: }
                   13776: 
                   13777: ############################################################
                   13778: ############################################################
                   13779: 
                   13780: =pod
                   13781: 
1.648     raeburn  13782: =item * &DrawXYYGraph()
1.138     matthew  13783: 
                   13784: Facilitates the plotting of data in an XY graph with two Y axes.
                   13785: Puts plot definition data into the users environment in order for 
                   13786: graph.png to plot it.  Returns an <img> tag for the plot.
                   13787: 
                   13788: Inputs:
                   13789: 
                   13790: =over 4
                   13791: 
                   13792: =item $Title: string, the title of the plot
                   13793: 
                   13794: =item $xlabel: string, text describing the X-axis of the plot
                   13795: 
                   13796: =item $ylabel: string, text describing the Y-axis of the plot
                   13797: 
                   13798: =item $colors: Array ref containing the hex color codes for the data to be 
                   13799: plotted in.  If undefined, default values will be used.
                   13800: 
                   13801: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13802: 
                   13803: =item $Ydata1: The first data set
                   13804: 
                   13805: =item $Min1: The minimum value of the left Y-axis
                   13806: 
                   13807: =item $Max1: The maximum value of the left Y-axis
                   13808: 
                   13809: =item $Ydata2: The second data set
                   13810: 
                   13811: =item $Min2: The minimum value of the right Y-axis
                   13812: 
                   13813: =item $Max2: The maximum value of the left Y-axis
                   13814: 
                   13815: =item %Values: hash indicating or overriding any default values which are 
                   13816: passed to graph.png.  
                   13817: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13818: 
                   13819: =back
                   13820: 
                   13821: Returns:
                   13822: 
                   13823: An <img> tag which references graph.png and the appropriate identifying
                   13824: information for the plot.
1.136     matthew  13825: 
                   13826: =cut
                   13827: 
                   13828: ############################################################
                   13829: ############################################################
1.137     matthew  13830: sub DrawXYYGraph {
                   13831:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13832:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13833:     #
                   13834:     # Create the identifier for the graph
                   13835:     my $identifier = &get_cgi_id();
                   13836:     my $id = 'cgi.'.$identifier;
                   13837:     #
                   13838:     $Title  = '' if (! defined($Title));
                   13839:     $xlabel = '' if (! defined($xlabel));
                   13840:     $ylabel = '' if (! defined($ylabel));
                   13841:     my %ValuesHash = 
                   13842:         (
1.369     www      13843:          $id.'.title'  => &escape($Title),
                   13844:          $id.'.xlabel' => &escape($xlabel),
                   13845:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13846:          $id.'.labels' => join(',',@$Xlabels),
                   13847:          $id.'.PlotType' => 'XY',
                   13848:          $id.'.NumSets' => 2,
1.137     matthew  13849:          $id.'.two_axes' => 1,
                   13850:          $id.'.y1_max_value' => $Max1,
                   13851:          $id.'.y1_min_value' => $Min1,
                   13852:          $id.'.y2_max_value' => $Max2,
                   13853:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13854:          );
                   13855:     #
1.137     matthew  13856:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13857:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13858:     }
                   13859:     #
                   13860:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13861:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13862:         return '';
                   13863:     }
                   13864:     my $NumSets=1;
1.137     matthew  13865:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13866:         next if (! ref($array));
                   13867:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13868:     }
                   13869:     #
                   13870:     # Deal with other parameters
                   13871:     while (my ($key,$value) = each(%Values)) {
                   13872:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13873:     }
                   13874:     #
1.646     raeburn  13875:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13876:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13877: }
                   13878: 
                   13879: ############################################################
                   13880: ############################################################
                   13881: 
                   13882: =pod
                   13883: 
1.157     matthew  13884: =back 
                   13885: 
1.139     matthew  13886: =head1 Statistics helper routines?  
                   13887: 
                   13888: Bad place for them but what the hell.
                   13889: 
1.157     matthew  13890: =over 4
                   13891: 
1.648     raeburn  13892: =item * &chartlink()
1.139     matthew  13893: 
                   13894: Returns a link to the chart for a specific student.  
                   13895: 
                   13896: Inputs:
                   13897: 
                   13898: =over 4
                   13899: 
                   13900: =item $linktext: The text of the link
                   13901: 
                   13902: =item $sname: The students username
                   13903: 
                   13904: =item $sdomain: The students domain
                   13905: 
                   13906: =back
                   13907: 
1.157     matthew  13908: =back
                   13909: 
1.139     matthew  13910: =cut
                   13911: 
                   13912: ############################################################
                   13913: ############################################################
                   13914: sub chartlink {
                   13915:     my ($linktext, $sname, $sdomain) = @_;
                   13916:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13917:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13918:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13919:        '">'.$linktext.'</a>';
1.153     matthew  13920: }
                   13921: 
                   13922: #######################################################
                   13923: #######################################################
                   13924: 
                   13925: =pod
                   13926: 
                   13927: =head1 Course Environment Routines
1.157     matthew  13928: 
                   13929: =over 4
1.153     matthew  13930: 
1.648     raeburn  13931: =item * &restore_course_settings()
1.153     matthew  13932: 
1.648     raeburn  13933: =item * &store_course_settings()
1.153     matthew  13934: 
                   13935: Restores/Store indicated form parameters from the course environment.
                   13936: Will not overwrite existing values of the form parameters.
                   13937: 
                   13938: Inputs: 
                   13939: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13940: 
                   13941: a hash ref describing the data to be stored.  For example:
                   13942:    
                   13943: %Save_Parameters = ('Status' => 'scalar',
                   13944:     'chartoutputmode' => 'scalar',
                   13945:     'chartoutputdata' => 'scalar',
                   13946:     'Section' => 'array',
1.373     raeburn  13947:     'Group' => 'array',
1.153     matthew  13948:     'StudentData' => 'array',
                   13949:     'Maps' => 'array');
                   13950: 
                   13951: Returns: both routines return nothing
                   13952: 
1.631     raeburn  13953: =back
                   13954: 
1.153     matthew  13955: =cut
                   13956: 
                   13957: #######################################################
                   13958: #######################################################
                   13959: sub store_course_settings {
1.496     albertel 13960:     return &store_settings($env{'request.course.id'},@_);
                   13961: }
                   13962: 
                   13963: sub store_settings {
1.153     matthew  13964:     # save to the environment
                   13965:     # appenv the same items, just to be safe
1.300     albertel 13966:     my $udom  = $env{'user.domain'};
                   13967:     my $uname = $env{'user.name'};
1.496     albertel 13968:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13969:     my %SaveHash;
                   13970:     my %AppHash;
                   13971:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13972:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13973:         my $envname = 'environment.'.$basename;
1.258     albertel 13974:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13975:             # Save this value away
                   13976:             if ($type eq 'scalar' &&
1.258     albertel 13977:                 (! exists($env{$envname}) || 
                   13978:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13979:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13980:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13981:             } elsif ($type eq 'array') {
                   13982:                 my $stored_form;
1.258     albertel 13983:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13984:                     $stored_form = join(',',
                   13985:                                         map {
1.369     www      13986:                                             &escape($_);
1.258     albertel 13987:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13988:                 } else {
                   13989:                     $stored_form = 
1.369     www      13990:                         &escape($env{'form.'.$setting});
1.153     matthew  13991:                 }
                   13992:                 # Determine if the array contents are the same.
1.258     albertel 13993:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13994:                     $SaveHash{$basename} = $stored_form;
                   13995:                     $AppHash{$envname}   = $stored_form;
                   13996:                 }
                   13997:             }
                   13998:         }
                   13999:     }
                   14000:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 14001:                                           $udom,$uname);
1.153     matthew  14002:     if ($put_result !~ /^(ok|delayed)/) {
                   14003:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   14004:                                  'got error:'.$put_result);
                   14005:     }
                   14006:     # Make sure these settings stick around in this session, too
1.646     raeburn  14007:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  14008:     return;
                   14009: }
                   14010: 
                   14011: sub restore_course_settings {
1.499     albertel 14012:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 14013: }
                   14014: 
                   14015: sub restore_settings {
                   14016:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14017:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 14018:         next if (exists($env{'form.'.$setting}));
1.496     albertel 14019:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  14020:             '.'.$setting;
1.258     albertel 14021:         if (exists($env{$envname})) {
1.153     matthew  14022:             if ($type eq 'scalar') {
1.258     albertel 14023:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  14024:             } elsif ($type eq 'array') {
1.258     albertel 14025:                 $env{'form.'.$setting} = [ 
1.153     matthew  14026:                                            map { 
1.369     www      14027:                                                &unescape($_); 
1.258     albertel 14028:                                            } split(',',$env{$envname})
1.153     matthew  14029:                                            ];
                   14030:             }
                   14031:         }
                   14032:     }
1.127     matthew  14033: }
                   14034: 
1.618     raeburn  14035: #######################################################
                   14036: #######################################################
                   14037: 
                   14038: =pod
                   14039: 
                   14040: =head1 Domain E-mail Routines  
                   14041: 
                   14042: =over 4
                   14043: 
1.648     raeburn  14044: =item * &build_recipient_list()
1.618     raeburn  14045: 
1.1144    raeburn  14046: Build recipient lists for following types of e-mail:
1.766     raeburn  14047: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  14048: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   14049: module change checking, student/employee ID conflict checks, as
                   14050: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   14051: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  14052: 
                   14053: Inputs:
1.619     raeburn  14054: defmail (scalar - email address of default recipient), 
1.1144    raeburn  14055: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   14056: requestsmail, updatesmail, or idconflictsmail).
                   14057: 
1.619     raeburn  14058: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  14059: 
1.619     raeburn  14060: origmail (scalar - email address of recipient from loncapa.conf, 
                   14061: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  14062: 
1.655     raeburn  14063: Returns: comma separated list of addresses to which to send e-mail.
                   14064: 
                   14065: =back
1.618     raeburn  14066: 
                   14067: =cut
                   14068: 
                   14069: ############################################################
                   14070: ############################################################
                   14071: sub build_recipient_list {
1.619     raeburn  14072:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  14073:     my @recipients;
                   14074:     my $otheremails;
                   14075:     my %domconfig =
                   14076:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   14077:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  14078:         if (exists($domconfig{'contacts'}{$mailing})) {
                   14079:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   14080:                 my @contacts = ('adminemail','supportemail');
                   14081:                 foreach my $item (@contacts) {
                   14082:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   14083:                         my $addr = $domconfig{'contacts'}{$item}; 
                   14084:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14085:                             push(@recipients,$addr);
                   14086:                         }
1.619     raeburn  14087:                     }
1.766     raeburn  14088:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  14089:                 }
                   14090:             }
1.766     raeburn  14091:         } elsif ($origmail ne '') {
                   14092:             push(@recipients,$origmail);
1.618     raeburn  14093:         }
1.619     raeburn  14094:     } elsif ($origmail ne '') {
                   14095:         push(@recipients,$origmail);
1.618     raeburn  14096:     }
1.688     raeburn  14097:     if (defined($defmail)) {
                   14098:         if ($defmail ne '') {
                   14099:             push(@recipients,$defmail);
                   14100:         }
1.618     raeburn  14101:     }
                   14102:     if ($otheremails) {
1.619     raeburn  14103:         my @others;
                   14104:         if ($otheremails =~ /,/) {
                   14105:             @others = split(/,/,$otheremails);
1.618     raeburn  14106:         } else {
1.619     raeburn  14107:             push(@others,$otheremails);
                   14108:         }
                   14109:         foreach my $addr (@others) {
                   14110:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14111:                 push(@recipients,$addr);
                   14112:             }
1.618     raeburn  14113:         }
                   14114:     }
1.619     raeburn  14115:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  14116:     return $recipientlist;
                   14117: }
                   14118: 
1.127     matthew  14119: ############################################################
                   14120: ############################################################
1.154     albertel 14121: 
1.655     raeburn  14122: =pod
                   14123: 
1.1224    musolffc 14124: =over 4
                   14125: 
1.1223    musolffc 14126: =item * &mime_email()
                   14127: 
                   14128: Sends an email with a possible attachment
                   14129: 
                   14130: Inputs:
                   14131: 
                   14132: =over 4
                   14133: 
                   14134: from -              Sender's email address
                   14135: 
                   14136: to -                Email address of recipient
                   14137: 
                   14138: subject -           Subject of email
                   14139: 
                   14140: body -              Body of email
                   14141: 
                   14142: cc_string -         Carbon copy email address
                   14143: 
                   14144: bcc -               Blind carbon copy email address
                   14145: 
                   14146: type -              File type of attachment
                   14147: 
                   14148: attachment_path -   Path of file to be attached
                   14149: 
                   14150: file_name -         Name of file to be attached
                   14151: 
                   14152: attachment_text -   The body of an attachment of type "TEXT"
                   14153: 
                   14154: =back
                   14155: 
                   14156: =back
                   14157: 
                   14158: =cut
                   14159: 
                   14160: ############################################################
                   14161: ############################################################
                   14162: 
                   14163: sub mime_email {
                   14164:     my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
                   14165:         $file_name, $attachment_text) = @_;
                   14166:     my $msg = MIME::Lite->new(
                   14167:              From    => $from,
                   14168:              To      => $to,
                   14169:              Subject => $subject,
                   14170:              Type    =>'TEXT',
                   14171:              Data    => $body,
                   14172:              );
                   14173:     if ($cc_string ne '') {
                   14174:         $msg->add("Cc" => $cc_string);
                   14175:     }
                   14176:     if ($bcc ne '') {
                   14177:         $msg->add("Bcc" => $bcc);
                   14178:     }
                   14179:     $msg->attr("content-type"         => "text/plain");
                   14180:     $msg->attr("content-type.charset" => "UTF-8");
                   14181:     # Attach file if given
                   14182:     if ($attachment_path) {
                   14183:         unless ($file_name) {
                   14184:             if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
                   14185:         }
                   14186:         my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
                   14187:         $msg->attach(Type     => $type,
                   14188:                      Path     => $attachment_path,
                   14189:                      Filename => $file_name
                   14190:                      );
                   14191:     # Otherwise attach text if given
                   14192:     } elsif ($attachment_text) {
                   14193:         $msg->attach(Type => 'TEXT',
                   14194:                      Data => $attachment_text);
                   14195:     }
                   14196:     # Send it
                   14197:     $msg->send('sendmail');
                   14198: }
                   14199: 
                   14200: ############################################################
                   14201: ############################################################
                   14202: 
                   14203: =pod
                   14204: 
1.655     raeburn  14205: =head1 Course Catalog Routines
                   14206: 
                   14207: =over 4
                   14208: 
                   14209: =item * &gather_categories()
                   14210: 
                   14211: Converts category definitions - keys of categories hash stored in  
                   14212: coursecategories in configuration.db on the primary library server in a 
                   14213: domain - to an array.  Also generates javascript and idx hash used to 
                   14214: generate Domain Coordinator interface for editing Course Categories.
                   14215: 
                   14216: Inputs:
1.663     raeburn  14217: 
1.655     raeburn  14218: categories (reference to hash of category definitions).
1.663     raeburn  14219: 
1.655     raeburn  14220: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14221:       categories and subcategories).
1.663     raeburn  14222: 
1.655     raeburn  14223: idx (reference to hash of counters used in Domain Coordinator interface for 
                   14224:       editing Course Categories).
1.663     raeburn  14225: 
1.655     raeburn  14226: jsarray (reference to array of categories used to create Javascript arrays for
                   14227:          Domain Coordinator interface for editing Course Categories).
                   14228: 
                   14229: Returns: nothing
                   14230: 
                   14231: Side effects: populates cats, idx and jsarray. 
                   14232: 
                   14233: =cut
                   14234: 
                   14235: sub gather_categories {
                   14236:     my ($categories,$cats,$idx,$jsarray) = @_;
                   14237:     my %counters;
                   14238:     my $num = 0;
                   14239:     foreach my $item (keys(%{$categories})) {
                   14240:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   14241:         if ($container eq '' && $depth == 0) {
                   14242:             $cats->[$depth][$categories->{$item}] = $cat;
                   14243:         } else {
                   14244:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   14245:         }
                   14246:         my ($escitem,$tail) = split(/:/,$item,2);
                   14247:         if ($counters{$tail} eq '') {
                   14248:             $counters{$tail} = $num;
                   14249:             $num ++;
                   14250:         }
                   14251:         if (ref($idx) eq 'HASH') {
                   14252:             $idx->{$item} = $counters{$tail};
                   14253:         }
                   14254:         if (ref($jsarray) eq 'ARRAY') {
                   14255:             push(@{$jsarray->[$counters{$tail}]},$item);
                   14256:         }
                   14257:     }
                   14258:     return;
                   14259: }
                   14260: 
                   14261: =pod
                   14262: 
                   14263: =item * &extract_categories()
                   14264: 
                   14265: Used to generate breadcrumb trails for course categories.
                   14266: 
                   14267: Inputs:
1.663     raeburn  14268: 
1.655     raeburn  14269: categories (reference to hash of category definitions).
1.663     raeburn  14270: 
1.655     raeburn  14271: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14272:       categories and subcategories).
1.663     raeburn  14273: 
1.655     raeburn  14274: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  14275: 
1.655     raeburn  14276: allitems (reference to hash - key is category key 
                   14277:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14278: 
1.655     raeburn  14279: idx (reference to hash of counters used in Domain Coordinator interface for
                   14280:       editing Course Categories).
1.663     raeburn  14281: 
1.655     raeburn  14282: jsarray (reference to array of categories used to create Javascript arrays for
                   14283:          Domain Coordinator interface for editing Course Categories).
                   14284: 
1.665     raeburn  14285: subcats (reference to hash of arrays containing all subcategories within each 
                   14286:          category, -recursive)
                   14287: 
1.655     raeburn  14288: Returns: nothing
                   14289: 
                   14290: Side effects: populates trails and allitems hash references.
                   14291: 
                   14292: =cut
                   14293: 
                   14294: sub extract_categories {
1.665     raeburn  14295:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  14296:     if (ref($categories) eq 'HASH') {
                   14297:         &gather_categories($categories,$cats,$idx,$jsarray);
                   14298:         if (ref($cats->[0]) eq 'ARRAY') {
                   14299:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   14300:                 my $name = $cats->[0][$i];
                   14301:                 my $item = &escape($name).'::0';
                   14302:                 my $trailstr;
                   14303:                 if ($name eq 'instcode') {
                   14304:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  14305:                 } elsif ($name eq 'communities') {
                   14306:                     $trailstr = &mt('Communities');
1.1239    raeburn  14307:                 } elsif ($name eq 'placement') {
                   14308:                     $trailstr = &mt('Placement Tests');
1.655     raeburn  14309:                 } else {
                   14310:                     $trailstr = $name;
                   14311:                 }
                   14312:                 if ($allitems->{$item} eq '') {
                   14313:                     push(@{$trails},$trailstr);
                   14314:                     $allitems->{$item} = scalar(@{$trails})-1;
                   14315:                 }
                   14316:                 my @parents = ($name);
                   14317:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   14318:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   14319:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  14320:                         if (ref($subcats) eq 'HASH') {
                   14321:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   14322:                         }
                   14323:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   14324:                     }
                   14325:                 } else {
                   14326:                     if (ref($subcats) eq 'HASH') {
                   14327:                         $subcats->{$item} = [];
1.655     raeburn  14328:                     }
                   14329:                 }
                   14330:             }
                   14331:         }
                   14332:     }
                   14333:     return;
                   14334: }
                   14335: 
                   14336: =pod
                   14337: 
1.1162    raeburn  14338: =item * &recurse_categories()
1.655     raeburn  14339: 
                   14340: Recursively used to generate breadcrumb trails for course categories.
                   14341: 
                   14342: Inputs:
1.663     raeburn  14343: 
1.655     raeburn  14344: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14345:       categories and subcategories).
1.663     raeburn  14346: 
1.655     raeburn  14347: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  14348: 
                   14349: category (current course category, for which breadcrumb trail is being generated).
                   14350: 
                   14351: trails (reference to array of breadcrumb trails for each category).
                   14352: 
1.655     raeburn  14353: allitems (reference to hash - key is category key
                   14354:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14355: 
1.655     raeburn  14356: parents (array containing containers directories for current category, 
                   14357:          back to top level). 
                   14358: 
                   14359: Returns: nothing
                   14360: 
                   14361: Side effects: populates trails and allitems hash references
                   14362: 
                   14363: =cut
                   14364: 
                   14365: sub recurse_categories {
1.665     raeburn  14366:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  14367:     my $shallower = $depth - 1;
                   14368:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   14369:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   14370:             my $name = $cats->[$depth]{$category}[$k];
                   14371:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14372:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14373:             if ($allitems->{$item} eq '') {
                   14374:                 push(@{$trails},$trailstr);
                   14375:                 $allitems->{$item} = scalar(@{$trails})-1;
                   14376:             }
                   14377:             my $deeper = $depth+1;
                   14378:             push(@{$parents},$category);
1.665     raeburn  14379:             if (ref($subcats) eq 'HASH') {
                   14380:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   14381:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   14382:                     my $higher;
                   14383:                     if ($j > 0) {
                   14384:                         $higher = &escape($parents->[$j]).':'.
                   14385:                                   &escape($parents->[$j-1]).':'.$j;
                   14386:                     } else {
                   14387:                         $higher = &escape($parents->[$j]).'::'.$j;
                   14388:                     }
                   14389:                     push(@{$subcats->{$higher}},$subcat);
                   14390:                 }
                   14391:             }
                   14392:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   14393:                                 $subcats);
1.655     raeburn  14394:             pop(@{$parents});
                   14395:         }
                   14396:     } else {
                   14397:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14398:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14399:         if ($allitems->{$item} eq '') {
                   14400:             push(@{$trails},$trailstr);
                   14401:             $allitems->{$item} = scalar(@{$trails})-1;
                   14402:         }
                   14403:     }
                   14404:     return;
                   14405: }
                   14406: 
1.663     raeburn  14407: =pod
                   14408: 
1.1162    raeburn  14409: =item * &assign_categories_table()
1.663     raeburn  14410: 
                   14411: Create a datatable for display of hierarchical categories in a domain,
                   14412: with checkboxes to allow a course to be categorized. 
                   14413: 
                   14414: Inputs:
                   14415: 
                   14416: cathash - reference to hash of categories defined for the domain (from
                   14417:           configuration.db)
                   14418: 
                   14419: currcat - scalar with an & separated list of categories assigned to a course. 
                   14420: 
1.919     raeburn  14421: type    - scalar contains course type (Course or Community).
                   14422: 
1.663     raeburn  14423: Returns: $output (markup to be displayed) 
                   14424: 
                   14425: =cut
                   14426: 
                   14427: sub assign_categories_table {
1.919     raeburn  14428:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  14429:     my $output;
                   14430:     if (ref($cathash) eq 'HASH') {
                   14431:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   14432:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   14433:         $maxdepth = scalar(@cats);
                   14434:         if (@cats > 0) {
                   14435:             my $itemcount = 0;
                   14436:             if (ref($cats[0]) eq 'ARRAY') {
                   14437:                 my @currcategories;
                   14438:                 if ($currcat ne '') {
                   14439:                     @currcategories = split('&',$currcat);
                   14440:                 }
1.919     raeburn  14441:                 my $table;
1.663     raeburn  14442:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   14443:                     my $parent = $cats[0][$i];
1.919     raeburn  14444:                     next if ($parent eq 'instcode');
                   14445:                     if ($type eq 'Community') {
                   14446:                         next unless ($parent eq 'communities');
1.1239    raeburn  14447:                     } elsif ($type eq 'Placement') {
                   14448:                         next unless ($parent eq 'placement');
1.919     raeburn  14449:                     } else {
1.1239    raeburn  14450:                         next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919     raeburn  14451:                     }
1.663     raeburn  14452:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   14453:                     my $item = &escape($parent).'::0';
                   14454:                     my $checked = '';
                   14455:                     if (@currcategories > 0) {
                   14456:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   14457:                             $checked = ' checked="checked"';
1.663     raeburn  14458:                         }
                   14459:                     }
1.919     raeburn  14460:                     my $parent_title = $parent;
                   14461:                     if ($parent eq 'communities') {
                   14462:                         $parent_title = &mt('Communities');
1.1239    raeburn  14463:                     } elsif ($parent eq 'placement') {
                   14464:                         $parent_title = &mt('Placement Tests');
1.919     raeburn  14465:                     }
                   14466:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   14467:                               '<input type="checkbox" name="usecategory" value="'.
                   14468:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   14469:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  14470:                     my $depth = 1;
                   14471:                     push(@path,$parent);
1.919     raeburn  14472:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  14473:                     pop(@path);
1.919     raeburn  14474:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  14475:                     $itemcount ++;
                   14476:                 }
1.919     raeburn  14477:                 if ($itemcount) {
                   14478:                     $output = &Apache::loncommon::start_data_table().
                   14479:                               $table.
                   14480:                               &Apache::loncommon::end_data_table();
                   14481:                 }
1.663     raeburn  14482:             }
                   14483:         }
                   14484:     }
                   14485:     return $output;
                   14486: }
                   14487: 
                   14488: =pod
                   14489: 
1.1162    raeburn  14490: =item * &assign_category_rows()
1.663     raeburn  14491: 
                   14492: Create a datatable row for display of nested categories in a domain,
                   14493: with checkboxes to allow a course to be categorized,called recursively.
                   14494: 
                   14495: Inputs:
                   14496: 
                   14497: itemcount - track row number for alternating colors
                   14498: 
                   14499: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   14500:       categories and subcategories.
                   14501: 
                   14502: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   14503: 
                   14504: parent - parent of current category item
                   14505: 
                   14506: path - Array containing all categories back up through the hierarchy from the
                   14507:        current category to the top level.
                   14508: 
                   14509: currcategories - reference to array of current categories assigned to the course
                   14510: 
                   14511: Returns: $output (markup to be displayed).
                   14512: 
                   14513: =cut
                   14514: 
                   14515: sub assign_category_rows {
                   14516:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   14517:     my ($text,$name,$item,$chgstr);
                   14518:     if (ref($cats) eq 'ARRAY') {
                   14519:         my $maxdepth = scalar(@{$cats});
                   14520:         if (ref($cats->[$depth]) eq 'HASH') {
                   14521:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   14522:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   14523:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  14524:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  14525:                 for (my $j=0; $j<$numchildren; $j++) {
                   14526:                     $name = $cats->[$depth]{$parent}[$j];
                   14527:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   14528:                     my $deeper = $depth+1;
                   14529:                     my $checked = '';
                   14530:                     if (ref($currcategories) eq 'ARRAY') {
                   14531:                         if (@{$currcategories} > 0) {
                   14532:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   14533:                                 $checked = ' checked="checked"';
1.663     raeburn  14534:                             }
                   14535:                         }
                   14536:                     }
1.664     raeburn  14537:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   14538:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  14539:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   14540:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   14541:                              '</td><td>';
1.663     raeburn  14542:                     if (ref($path) eq 'ARRAY') {
                   14543:                         push(@{$path},$name);
                   14544:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   14545:                         pop(@{$path});
                   14546:                     }
                   14547:                     $text .= '</td></tr>';
                   14548:                 }
                   14549:                 $text .= '</table></td>';
                   14550:             }
                   14551:         }
                   14552:     }
                   14553:     return $text;
                   14554: }
                   14555: 
1.1181    raeburn  14556: =pod
                   14557: 
                   14558: =back
                   14559: 
                   14560: =cut
                   14561: 
1.655     raeburn  14562: ############################################################
                   14563: ############################################################
                   14564: 
                   14565: 
1.443     albertel 14566: sub commit_customrole {
1.664     raeburn  14567:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  14568:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 14569:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   14570:                          ($end?', ending '.localtime($end):'').': <b>'.
                   14571:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  14572:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 14573:                  '</b><br />';
                   14574:     return $output;
                   14575: }
                   14576: 
                   14577: sub commit_standardrole {
1.1116    raeburn  14578:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  14579:     my ($output,$logmsg,$linefeed);
                   14580:     if ($context eq 'auto') {
                   14581:         $linefeed = "\n";
                   14582:     } else {
                   14583:         $linefeed = "<br />\n";
                   14584:     }  
1.443     albertel 14585:     if ($three eq 'st') {
1.541     raeburn  14586:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  14587:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  14588:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  14589:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   14590:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 14591:         } else {
1.541     raeburn  14592:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 14593:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14594:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   14595:             if ($context eq 'auto') {
                   14596:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   14597:             } else {
                   14598:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   14599:                &mt('Add to classlist').': <b>ok</b>';
                   14600:             }
                   14601:             $output .= $linefeed;
1.443     albertel 14602:         }
                   14603:     } else {
                   14604:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   14605:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14606:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  14607:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  14608:         if ($context eq 'auto') {
                   14609:             $output .= $result.$linefeed;
                   14610:         } else {
                   14611:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   14612:         }
1.443     albertel 14613:     }
                   14614:     return $output;
                   14615: }
                   14616: 
                   14617: sub commit_studentrole {
1.1116    raeburn  14618:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   14619:         $credits) = @_;
1.626     raeburn  14620:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  14621:     if ($context eq 'auto') {
                   14622:         $linefeed = "\n";
                   14623:     } else {
                   14624:         $linefeed = '<br />'."\n";
                   14625:     }
1.443     albertel 14626:     if (defined($one) && defined($two)) {
                   14627:         my $cid=$one.'_'.$two;
                   14628:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   14629:         my $secchange = 0;
                   14630:         my $expire_role_result;
                   14631:         my $modify_section_result;
1.628     raeburn  14632:         if ($oldsec ne '-1') { 
                   14633:             if ($oldsec ne $sec) {
1.443     albertel 14634:                 $secchange = 1;
1.628     raeburn  14635:                 my $now = time;
1.443     albertel 14636:                 my $uurl='/'.$cid;
                   14637:                 $uurl=~s/\_/\//g;
                   14638:                 if ($oldsec) {
                   14639:                     $uurl.='/'.$oldsec;
                   14640:                 }
1.626     raeburn  14641:                 $oldsecurl = $uurl;
1.628     raeburn  14642:                 $expire_role_result = 
1.652     raeburn  14643:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  14644:                 if ($env{'request.course.sec'} ne '') { 
                   14645:                     if ($expire_role_result eq 'refused') {
                   14646:                         my @roles = ('st');
                   14647:                         my @statuses = ('previous');
                   14648:                         my @roledoms = ($one);
                   14649:                         my $withsec = 1;
                   14650:                         my %roleshash = 
                   14651:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   14652:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   14653:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   14654:                             my ($oldstart,$oldend) = 
                   14655:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   14656:                             if ($oldend > 0 && $oldend <= $now) {
                   14657:                                 $expire_role_result = 'ok';
                   14658:                             }
                   14659:                         }
                   14660:                     }
                   14661:                 }
1.443     albertel 14662:                 $result = $expire_role_result;
                   14663:             }
                   14664:         }
                   14665:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  14666:             $modify_section_result = 
                   14667:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   14668:                                                            undef,undef,undef,$sec,
                   14669:                                                            $end,$start,'','',$cid,
                   14670:                                                            '',$context,$credits);
1.443     albertel 14671:             if ($modify_section_result =~ /^ok/) {
                   14672:                 if ($secchange == 1) {
1.628     raeburn  14673:                     if ($sec eq '') {
                   14674:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   14675:                     } else {
                   14676:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   14677:                     }
1.443     albertel 14678:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  14679:                     if ($sec eq '') {
                   14680:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   14681:                     } else {
                   14682:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14683:                     }
1.443     albertel 14684:                 } else {
1.628     raeburn  14685:                     if ($sec eq '') {
                   14686:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   14687:                     } else {
                   14688:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14689:                     }
1.443     albertel 14690:                 }
                   14691:             } else {
1.1115    raeburn  14692:                 if ($secchange) { 
1.628     raeburn  14693:                     $$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;
                   14694:                 } else {
                   14695:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   14696:                 }
1.443     albertel 14697:             }
                   14698:             $result = $modify_section_result;
                   14699:         } elsif ($secchange == 1) {
1.628     raeburn  14700:             if ($oldsec eq '') {
1.1103    raeburn  14701:                 $$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  14702:             } else {
                   14703:                 $$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;
                   14704:             }
1.626     raeburn  14705:             if ($expire_role_result eq 'refused') {
                   14706:                 my $newsecurl = '/'.$cid;
                   14707:                 $newsecurl =~ s/\_/\//g;
                   14708:                 if ($sec ne '') {
                   14709:                     $newsecurl.='/'.$sec;
                   14710:                 }
                   14711:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   14712:                     if ($sec eq '') {
                   14713:                         $$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;
                   14714:                     } else {
                   14715:                         $$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;
                   14716:                     }
                   14717:                 }
                   14718:             }
1.443     albertel 14719:         }
                   14720:     } else {
1.626     raeburn  14721:         $$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 14722:         $result = "error: incomplete course id\n";
                   14723:     }
                   14724:     return $result;
                   14725: }
                   14726: 
1.1108    raeburn  14727: sub show_role_extent {
                   14728:     my ($scope,$context,$role) = @_;
                   14729:     $scope =~ s{^/}{};
                   14730:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   14731:     push(@courseroles,'co');
                   14732:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   14733:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   14734:         $scope =~ s{/}{_};
                   14735:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   14736:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   14737:         my ($audom,$auname) = split(/\//,$scope);
                   14738:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   14739:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   14740:     } else {
                   14741:         $scope =~ s{/$}{};
                   14742:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   14743:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   14744:     }
                   14745: }
                   14746: 
1.443     albertel 14747: ############################################################
                   14748: ############################################################
                   14749: 
1.566     albertel 14750: sub check_clone {
1.578     raeburn  14751:     my ($args,$linefeed) = @_;
1.566     albertel 14752:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   14753:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   14754:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   14755:     my $clonemsg;
                   14756:     my $can_clone = 0;
1.944     raeburn  14757:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  14758:     if ($lctype ne 'community') {
                   14759:         $lctype = 'course';
                   14760:     }
1.566     albertel 14761:     if ($clonehome eq 'no_host') {
1.944     raeburn  14762:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14763:             $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'});
                   14764:         } else {
                   14765:             $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'});
                   14766:         }     
1.566     albertel 14767:     } else {
                   14768: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  14769:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14770:             if ($clonedesc{'type'} ne 'Community') {
                   14771:                  $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'});
                   14772:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14773:             }
                   14774:         }
1.882     raeburn  14775: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   14776:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 14777: 	    $can_clone = 1;
                   14778: 	} else {
1.1221    raeburn  14779: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 14780: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1221    raeburn  14781:             if ($clonehash{'cloners'} eq '') {
                   14782:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   14783:                 if ($domdefs{'canclone'}) {
                   14784:                     unless ($domdefs{'canclone'} eq 'none') {
                   14785:                         if ($domdefs{'canclone'} eq 'domain') {
                   14786:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   14787:                                 $can_clone = 1;
                   14788:                             }
                   14789:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   14790:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   14791:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   14792:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   14793:                                 $can_clone = 1;
                   14794:                             }
                   14795:                         }
                   14796:                     }
                   14797:                 }
1.578     raeburn  14798:             } else {
1.1221    raeburn  14799: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   14800:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  14801:                     $can_clone = 1;
1.1221    raeburn  14802:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  14803:                     $can_clone = 1;
1.1225    raeburn  14804:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   14805:                     $can_clone = 1;
1.1221    raeburn  14806:                 }
                   14807:                 unless ($can_clone) {
1.1225    raeburn  14808:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   14809:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1221    raeburn  14810:                         my (%gotdomdefaults,%gotcodedefaults);
                   14811:                         foreach my $cloner (@cloners) {
                   14812:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   14813:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   14814:                                 my (%codedefaults,@code_order);
                   14815:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   14816:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   14817:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   14818:                                     }
                   14819:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   14820:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   14821:                                     }
                   14822:                                 } else {
                   14823:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   14824:                                                                             \%codedefaults,
                   14825:                                                                             \@code_order);
                   14826:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   14827:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   14828:                                 }
                   14829:                                 if (@code_order > 0) {
                   14830:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   14831:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   14832:                                                                                 $args->{'crscode'})) {
                   14833:                                         $can_clone = 1;
                   14834:                                         last;
                   14835:                                     }
                   14836:                                 }
                   14837:                             }
                   14838:                         }
                   14839:                     }
1.1225    raeburn  14840:                 }
                   14841:             }
                   14842:             unless ($can_clone) {
                   14843:                 my $ccrole = 'cc';
                   14844:                 if ($args->{'crstype'} eq 'Community') {
                   14845:                     $ccrole = 'co';
                   14846:                 }
                   14847: 	        my %roleshash =
                   14848: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   14849: 					          $args->{'ccdomain'},
                   14850:                                                   'userroles',['active'],[$ccrole],
                   14851: 					          [$args->{'clonedomain'}]);
                   14852: 	        if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   14853:                     $can_clone = 1;
                   14854:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   14855:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   14856:                     $can_clone = 1;
1.1221    raeburn  14857:                 }
                   14858:             }
                   14859:             unless ($can_clone) {
                   14860:                 if ($args->{'crstype'} eq 'Community') {
                   14861:                     $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  14862:                 } else {
1.1221    raeburn  14863:                     $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'});
                   14864:                 }
1.566     albertel 14865: 	    }
1.578     raeburn  14866:         }
1.566     albertel 14867:     }
                   14868:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14869: }
                   14870: 
1.444     albertel 14871: sub construct_course {
1.1166    raeburn  14872:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 14873:     my $outcome;
1.541     raeburn  14874:     my $linefeed =  '<br />'."\n";
                   14875:     if ($context eq 'auto') {
                   14876:         $linefeed = "\n";
                   14877:     }
1.566     albertel 14878: 
                   14879: #
                   14880: # Are we cloning?
                   14881: #
                   14882:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14883:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  14884: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 14885: 	if ($context ne 'auto') {
1.578     raeburn  14886:             if ($clonemsg ne '') {
                   14887: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   14888:             }
1.566     albertel 14889: 	}
                   14890: 	$outcome .= $clonemsg.$linefeed;
                   14891: 
                   14892:         if (!$can_clone) {
                   14893: 	    return (0,$outcome);
                   14894: 	}
                   14895:     }
                   14896: 
1.444     albertel 14897: #
                   14898: # Open course
                   14899: #
1.1239    raeburn  14900:     my $showncrstype;
                   14901:     if ($args->{'crstype'} eq 'Placement') {
                   14902:         $showncrstype = 'placement test'; 
                   14903:     } else {  
                   14904:         $showncrstype = lc($args->{'crstype'});
                   14905:     }
1.444     albertel 14906:     my %cenv=();
                   14907:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   14908:                                              $args->{'cdescr'},
                   14909:                                              $args->{'curl'},
                   14910:                                              $args->{'course_home'},
                   14911:                                              $args->{'nonstandard'},
                   14912:                                              $args->{'crscode'},
                   14913:                                              $args->{'ccuname'}.':'.
                   14914:                                              $args->{'ccdomain'},
1.882     raeburn  14915:                                              $args->{'crstype'},
1.885     raeburn  14916:                                              $cnum,$context,$category);
1.444     albertel 14917: 
                   14918:     # Note: The testing routines depend on this being output; see 
                   14919:     # Utils::Course. This needs to at least be output as a comment
                   14920:     # if anyone ever decides to not show this, and Utils::Course::new
                   14921:     # will need to be suitably modified.
1.1239    raeburn  14922:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943     raeburn  14923:     if ($$courseid =~ /^error:/) {
                   14924:         return (0,$outcome);
                   14925:     }
                   14926: 
1.444     albertel 14927: #
                   14928: # Check if created correctly
                   14929: #
1.479     albertel 14930:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14931:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14932:     if ($crsuhome eq 'no_host') {
                   14933:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14934:         return (0,$outcome);
                   14935:     }
1.541     raeburn  14936:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14937: 
1.444     albertel 14938: #
1.566     albertel 14939: # Do the cloning
                   14940: #   
                   14941:     if ($can_clone && $cloneid) {
1.1239    raeburn  14942: 	$clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566     albertel 14943: 	if ($context ne 'auto') {
                   14944: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14945: 	}
                   14946: 	$outcome .= $clonemsg.$linefeed;
                   14947: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14948: # Copy all files
1.637     www      14949: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14950: # Restore URL
1.566     albertel 14951: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14952: # Restore title
1.566     albertel 14953: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14954: # Restore creation date, creator and creation context.
                   14955:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14956:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14957:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14958: # Mark as cloned
1.566     albertel 14959: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14960: # Need to clone grading mode
                   14961:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14962:         $cenv{'grading'}=$newenv{'grading'};
                   14963: # Do not clone these environment entries
                   14964:         &Apache::lonnet::del('environment',
                   14965:                   ['default_enrollment_start_date',
                   14966:                    'default_enrollment_end_date',
                   14967:                    'question.email',
                   14968:                    'policy.email',
                   14969:                    'comment.email',
                   14970:                    'pch.users.denied',
1.725     raeburn  14971:                    'plc.users.denied',
                   14972:                    'hidefromcat',
1.1121    raeburn  14973:                    'checkforpriv',
1.1166    raeburn  14974:                    'categories',
                   14975:                    'internal.uniquecode'],
1.638     www      14976:                    $$crsudom,$$crsunum);
1.1170    raeburn  14977:         if ($args->{'textbook'}) {
                   14978:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14979:         }
1.444     albertel 14980:     }
1.566     albertel 14981: 
1.444     albertel 14982: #
                   14983: # Set environment (will override cloned, if existing)
                   14984: #
                   14985:     my @sections = ();
                   14986:     my @xlists = ();
                   14987:     if ($args->{'crstype'}) {
                   14988:         $cenv{'type'}=$args->{'crstype'};
                   14989:     }
                   14990:     if ($args->{'crsid'}) {
                   14991:         $cenv{'courseid'}=$args->{'crsid'};
                   14992:     }
                   14993:     if ($args->{'crscode'}) {
                   14994:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14995:     }
                   14996:     if ($args->{'crsquota'} ne '') {
                   14997:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14998:     } else {
                   14999:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   15000:     }
                   15001:     if ($args->{'ccuname'}) {
                   15002:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   15003:                                         ':'.$args->{'ccdomain'};
                   15004:     } else {
                   15005:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   15006:     }
1.1116    raeburn  15007:     if ($args->{'defaultcredits'}) {
                   15008:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   15009:     }
1.444     albertel 15010:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   15011:     if ($args->{'crssections'}) {
                   15012:         $cenv{'internal.sectionnums'} = '';
                   15013:         if ($args->{'crssections'} =~ m/,/) {
                   15014:             @sections = split/,/,$args->{'crssections'};
                   15015:         } else {
                   15016:             $sections[0] = $args->{'crssections'};
                   15017:         }
                   15018:         if (@sections > 0) {
                   15019:             foreach my $item (@sections) {
                   15020:                 my ($sec,$gp) = split/:/,$item;
                   15021:                 my $class = $args->{'crscode'}.$sec;
                   15022:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   15023:                 $cenv{'internal.sectionnums'} .= $item.',';
                   15024:                 unless ($addcheck eq 'ok') {
                   15025:                     push @badclasses, $class;
                   15026:                 }
                   15027:             }
                   15028:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   15029:         }
                   15030:     }
                   15031: # do not hide course coordinator from staff listing, 
                   15032: # even if privileged
                   15033:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  15034: # add course coordinator's domain to domains to check for privileged users
                   15035: # if different to course domain
                   15036:     if ($$crsudom ne $args->{'ccdomain'}) {
                   15037:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   15038:     }
1.444     albertel 15039: # add crosslistings
                   15040:     if ($args->{'crsxlist'}) {
                   15041:         $cenv{'internal.crosslistings'}='';
                   15042:         if ($args->{'crsxlist'} =~ m/,/) {
                   15043:             @xlists = split/,/,$args->{'crsxlist'};
                   15044:         } else {
                   15045:             $xlists[0] = $args->{'crsxlist'};
                   15046:         }
                   15047:         if (@xlists > 0) {
                   15048:             foreach my $item (@xlists) {
                   15049:                 my ($xl,$gp) = split/:/,$item;
                   15050:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   15051:                 $cenv{'internal.crosslistings'} .= $item.',';
                   15052:                 unless ($addcheck eq 'ok') {
                   15053:                     push @badclasses, $xl;
                   15054:                 }
                   15055:             }
                   15056:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   15057:         }
                   15058:     }
                   15059:     if ($args->{'autoadds'}) {
                   15060:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   15061:     }
                   15062:     if ($args->{'autodrops'}) {
                   15063:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   15064:     }
                   15065: # check for notification of enrollment changes
                   15066:     my @notified = ();
                   15067:     if ($args->{'notify_owner'}) {
                   15068:         if ($args->{'ccuname'} ne '') {
                   15069:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   15070:         }
                   15071:     }
                   15072:     if ($args->{'notify_dc'}) {
                   15073:         if ($uname ne '') { 
1.630     raeburn  15074:             push(@notified,$uname.':'.$udom);
1.444     albertel 15075:         }
                   15076:     }
                   15077:     if (@notified > 0) {
                   15078:         my $notifylist;
                   15079:         if (@notified > 1) {
                   15080:             $notifylist = join(',',@notified);
                   15081:         } else {
                   15082:             $notifylist = $notified[0];
                   15083:         }
                   15084:         $cenv{'internal.notifylist'} = $notifylist;
                   15085:     }
                   15086:     if (@badclasses > 0) {
                   15087:         my %lt=&Apache::lonlocal::texthash(
                   15088:                 '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',
                   15089:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   15090:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   15091:         );
1.541     raeburn  15092:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   15093:                            ' ('.$lt{'adby'}.')';
                   15094:         if ($context eq 'auto') {
                   15095:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 15096:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  15097:             foreach my $item (@badclasses) {
                   15098:                 if ($context eq 'auto') {
                   15099:                     $outcome .= " - $item\n";
                   15100:                 } else {
                   15101:                     $outcome .= "<li>$item</li>\n";
                   15102:                 }
                   15103:             }
                   15104:             if ($context eq 'auto') {
                   15105:                 $outcome .= $linefeed;
                   15106:             } else {
1.566     albertel 15107:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  15108:             }
                   15109:         } 
1.444     albertel 15110:     }
                   15111:     if ($args->{'no_end_date'}) {
                   15112:         $args->{'endaccess'} = 0;
                   15113:     }
                   15114:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   15115:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   15116:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   15117:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   15118:     if ($args->{'showphotos'}) {
                   15119:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   15120:     }
                   15121:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   15122:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   15123:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   15124:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  15125:             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'); 
                   15126:             if ($context eq 'auto') {
                   15127:                 $outcome .= $krb_msg;
                   15128:             } else {
1.566     albertel 15129:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  15130:             }
                   15131:             $outcome .= $linefeed;
1.444     albertel 15132:         }
                   15133:     }
                   15134:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   15135:        if ($args->{'setpolicy'}) {
                   15136:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15137:        }
                   15138:        if ($args->{'setcontent'}) {
                   15139:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15140:        }
                   15141:     }
                   15142:     if ($args->{'reshome'}) {
                   15143: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   15144: 	$cenv{'reshome'}=~s/\/+$/\//;
                   15145:     }
                   15146: #
                   15147: # course has keyed access
                   15148: #
                   15149:     if ($args->{'setkeys'}) {
                   15150:        $cenv{'keyaccess'}='yes';
                   15151:     }
                   15152: # if specified, key authority is not course, but user
                   15153: # only active if keyaccess is yes
                   15154:     if ($args->{'keyauth'}) {
1.487     albertel 15155: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   15156: 	$user = &LONCAPA::clean_username($user);
                   15157: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     15158: 	if ($user ne '' && $domain ne '') {
1.487     albertel 15159: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 15160: 	}
                   15161:     }
                   15162: 
1.1166    raeburn  15163: #
1.1167    raeburn  15164: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  15165: #
                   15166:     if ($args->{'uniquecode'}) {
                   15167:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   15168:         if ($code) {
                   15169:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  15170:             my %crsinfo =
                   15171:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   15172:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   15173:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   15174:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   15175:             } 
1.1166    raeburn  15176:             if (ref($coderef)) {
                   15177:                 $$coderef = $code;
                   15178:             }
                   15179:         }
                   15180:     }
                   15181: 
1.444     albertel 15182:     if ($args->{'disresdis'}) {
                   15183:         $cenv{'pch.roles.denied'}='st';
                   15184:     }
                   15185:     if ($args->{'disablechat'}) {
                   15186:         $cenv{'plc.roles.denied'}='st';
                   15187:     }
                   15188: 
                   15189:     # Record we've not yet viewed the Course Initialization Helper for this 
                   15190:     # course
                   15191:     $cenv{'course.helper.not.run'} = 1;
                   15192:     #
                   15193:     # Use new Randomseed
                   15194:     #
                   15195:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   15196:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   15197:     #
                   15198:     # The encryption code and receipt prefix for this course
                   15199:     #
                   15200:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   15201:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   15202:     #
                   15203:     # By default, use standard grading
                   15204:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   15205: 
1.541     raeburn  15206:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   15207:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15208: #
                   15209: # Open all assignments
                   15210: #
                   15211:     if ($args->{'openall'}) {
                   15212:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   15213:        my %storecontent = ($storeunder         => time,
                   15214:                            $storeunder.'.type' => 'date_start');
                   15215:        
                   15216:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  15217:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15218:    }
                   15219: #
                   15220: # Set first page
                   15221: #
                   15222:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   15223: 	    || ($cloneid)) {
1.445     albertel 15224: 	use LONCAPA::map;
1.444     albertel 15225: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 15226: 
                   15227: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   15228:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   15229: 
1.444     albertel 15230:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   15231:         my $title; my $url;
                   15232:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   15233: 	    $title=&mt('Syllabus');
1.444     albertel 15234:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   15235:         } else {
1.963     raeburn  15236:             $title=&mt('Table of Contents');
1.444     albertel 15237:             $url='/adm/navmaps';
                   15238:         }
1.445     albertel 15239: 
                   15240:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   15241: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   15242: 
                   15243: 	if ($errtext) { $fatal=2; }
1.541     raeburn  15244:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 15245:     }
1.566     albertel 15246: 
1.1237    raeburn  15247: # 
                   15248: # Set params for Placement Tests
                   15249: #
1.1239    raeburn  15250:     if ($args->{'crstype'} eq 'Placement') {
                   15251:        my %storecontent; 
                   15252:        my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
                   15253:        my %defaults = (
                   15254:                         buttonshide   => { value => 'yes',
                   15255:                                            type => 'string_yesno',},
                   15256:                         type          => { value => 'randomizetry',
                   15257:                                            type  => 'string_questiontype',},
                   15258:                         maxtries      => { value => 1,
                   15259:                                            type => 'int_pos',},
                   15260:                         problemstatus => { value => 'no',
                   15261:                                            type  => 'string_problemstatus',},
                   15262:                       );
                   15263:        foreach my $key (keys(%defaults)) {
                   15264:            $storecontent{$prefix.$key} = $defaults{$key}{'value'};
                   15265:            $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
                   15266:        }
1.1237    raeburn  15267:        &Apache::lonnet::cput
                   15268:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
                   15269:     }
                   15270: 
1.566     albertel 15271:     return (1,$outcome);
1.444     albertel 15272: }
                   15273: 
1.1166    raeburn  15274: sub make_unique_code {
                   15275:     my ($cdom,$cnum) = @_;
                   15276:     # get lock on uniquecodes db
                   15277:     my $lockhash = {
                   15278:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   15279:                                                   ':'.$env{'user.domain'},
                   15280:                    };
                   15281:     my $tries = 0;
                   15282:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15283:     my ($code,$error);
                   15284:   
                   15285:     while (($gotlock ne 'ok') && ($tries<3)) {
                   15286:         $tries ++;
                   15287:         sleep 1;
                   15288:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15289:     }
                   15290:     if ($gotlock eq 'ok') {
                   15291:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   15292:         my $gotcode;
                   15293:         my $attempts = 0;
                   15294:         while ((!$gotcode) && ($attempts < 100)) {
                   15295:             $code = &generate_code();
                   15296:             if (!exists($currcodes{$code})) {
                   15297:                 $gotcode = 1;
                   15298:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   15299:                     $error = 'nostore';
                   15300:                 }
                   15301:             }
                   15302:             $attempts ++;
                   15303:         }
                   15304:         my @del_lock = ($cnum."\0".'uniquecodes');
                   15305:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   15306:     } else {
                   15307:         $error = 'nolock';
                   15308:     }
                   15309:     return ($code,$error);
                   15310: }
                   15311: 
                   15312: sub generate_code {
                   15313:     my $code;
                   15314:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   15315:     for (my $i=0; $i<6; $i++) {
                   15316:         my $lettnum = int (rand 2);
                   15317:         my $item = '';
                   15318:         if ($lettnum) {
                   15319:             $item = $letts[int( rand(18) )];
                   15320:         } else {
                   15321:             $item = 1+int( rand(8) );
                   15322:         }
                   15323:         $code .= $item;
                   15324:     }
                   15325:     return $code;
                   15326: }
                   15327: 
1.444     albertel 15328: ############################################################
                   15329: ############################################################
                   15330: 
1.1237    raeburn  15331: # Community, Course and Placement Test
1.378     raeburn  15332: sub course_type {
                   15333:     my ($cid) = @_;
                   15334:     if (!defined($cid)) {
                   15335:         $cid = $env{'request.course.id'};
                   15336:     }
1.404     albertel 15337:     if (defined($env{'course.'.$cid.'.type'})) {
                   15338:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  15339:     } else {
                   15340:         return 'Course';
1.377     raeburn  15341:     }
                   15342: }
1.156     albertel 15343: 
1.406     raeburn  15344: sub group_term {
                   15345:     my $crstype = &course_type();
                   15346:     my %names = (
                   15347:                   'Course' => 'group',
1.865     raeburn  15348:                   'Community' => 'group',
1.1237    raeburn  15349:                   'Placement' => 'group',
1.406     raeburn  15350:                 );
                   15351:     return $names{$crstype};
                   15352: }
                   15353: 
1.902     raeburn  15354: sub course_types {
1.1237    raeburn  15355:     my @types = ('official','unofficial','community','textbook','placement');
1.902     raeburn  15356:     my %typename = (
                   15357:                          official   => 'Official course',
                   15358:                          unofficial => 'Unofficial course',
                   15359:                          community  => 'Community',
1.1165    raeburn  15360:                          textbook   => 'Textbook course',
1.1237    raeburn  15361:                          placement  => 'Placement test',
1.902     raeburn  15362:                    );
                   15363:     return (\@types,\%typename);
                   15364: }
                   15365: 
1.156     albertel 15366: sub icon {
                   15367:     my ($file)=@_;
1.505     albertel 15368:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 15369:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 15370:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 15371:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   15372: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   15373: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15374: 	            $curfext.".gif") {
                   15375: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15376: 		$curfext.".gif";
                   15377: 	}
                   15378:     }
1.249     albertel 15379:     return &lonhttpdurl($iconname);
1.154     albertel 15380: } 
1.84      albertel 15381: 
1.575     albertel 15382: sub lonhttpdurl {
1.692     www      15383: #
                   15384: # Had been used for "small fry" static images on separate port 8080.
                   15385: # Modify here if lightweight http functionality desired again.
                   15386: # Currently eliminated due to increasing firewall issues.
                   15387: #
1.575     albertel 15388:     my ($url)=@_;
1.692     www      15389:     return $url;
1.215     albertel 15390: }
                   15391: 
1.213     albertel 15392: sub connection_aborted {
                   15393:     my ($r)=@_;
                   15394:     $r->print(" ");$r->rflush();
                   15395:     my $c = $r->connection;
                   15396:     return $c->aborted();
                   15397: }
                   15398: 
1.221     foxr     15399: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     15400: #    strings as 'strings'.
                   15401: sub escape_single {
1.221     foxr     15402:     my ($input) = @_;
1.223     albertel 15403:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     15404:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   15405:     return $input;
                   15406: }
1.223     albertel 15407: 
1.222     foxr     15408: #  Same as escape_single, but escape's "'s  This 
                   15409: #  can be used for  "strings"
                   15410: sub escape_double {
                   15411:     my ($input) = @_;
                   15412:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   15413:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   15414:     return $input;
                   15415: }
1.223     albertel 15416:  
1.222     foxr     15417: #   Escapes the last element of a full URL.
                   15418: sub escape_url {
                   15419:     my ($url)   = @_;
1.238     raeburn  15420:     my @urlslices = split(/\//, $url,-1);
1.369     www      15421:     my $lastitem = &escape(pop(@urlslices));
1.1203    raeburn  15422:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     15423: }
1.462     albertel 15424: 
1.820     raeburn  15425: sub compare_arrays {
                   15426:     my ($arrayref1,$arrayref2) = @_;
                   15427:     my (@difference,%count);
                   15428:     @difference = ();
                   15429:     %count = ();
                   15430:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   15431:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   15432:         foreach my $element (keys(%count)) {
                   15433:             if ($count{$element} == 1) {
                   15434:                 push(@difference,$element);
                   15435:             }
                   15436:         }
                   15437:     }
                   15438:     return @difference;
                   15439: }
                   15440: 
1.817     bisitz   15441: # -------------------------------------------------------- Initialize user login
1.462     albertel 15442: sub init_user_environment {
1.463     albertel 15443:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 15444:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   15445: 
                   15446:     my $public=($username eq 'public' && $domain eq 'public');
                   15447: 
                   15448: # See if old ID present, if so, remove
                   15449: 
1.1062    raeburn  15450:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 15451:     my $now=time;
                   15452: 
                   15453:     if ($public) {
                   15454: 	my $max_public=100;
                   15455: 	my $oldest;
                   15456: 	my $oldest_time=0;
                   15457: 	for(my $next=1;$next<=$max_public;$next++) {
                   15458: 	    if (-e $lonids."/publicuser_$next.id") {
                   15459: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   15460: 		if ($mtime<$oldest_time || !$oldest_time) {
                   15461: 		    $oldest_time=$mtime;
                   15462: 		    $oldest=$next;
                   15463: 		}
                   15464: 	    } else {
                   15465: 		$cookie="publicuser_$next";
                   15466: 		last;
                   15467: 	    }
                   15468: 	}
                   15469: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   15470:     } else {
1.463     albertel 15471: 	# if this isn't a robot, kill any existing non-robot sessions
                   15472: 	if (!$args->{'robot'}) {
                   15473: 	    opendir(DIR,$lonids);
                   15474: 	    while ($filename=readdir(DIR)) {
                   15475: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   15476: 		    unlink($lonids.'/'.$filename);
                   15477: 		}
1.462     albertel 15478: 	    }
1.463     albertel 15479: 	    closedir(DIR);
1.1204    raeburn  15480: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   15481:             my $namespace = 'nohist_courseeditor';
                   15482:             my $lockingkey = 'paste'."\0".'locked_num';
                   15483:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   15484:                                                 $domain,$username);
                   15485:             if (exists($lockhash{$lockingkey})) {
                   15486:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   15487:                 unless ($delresult eq 'ok') {
                   15488:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   15489:                 }
                   15490:             }
1.462     albertel 15491: 	}
                   15492: # Give them a new cookie
1.463     albertel 15493: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      15494: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 15495: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 15496:     
                   15497: # Initialize roles
                   15498: 
1.1062    raeburn  15499: 	($userroles,$firstaccenv,$timerintenv) = 
                   15500:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 15501:     }
                   15502: # ------------------------------------ Check browser type and MathML capability
                   15503: 
1.1194    raeburn  15504:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   15505:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 15506: 
                   15507: # ------------------------------------------------------------- Get environment
                   15508: 
                   15509:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   15510:     my ($tmp) = keys(%userenv);
                   15511:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   15512:     } else {
                   15513: 	undef(%userenv);
                   15514:     }
                   15515:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   15516: 	$form->{'interface'}=$userenv{'interface'};
                   15517:     }
                   15518:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   15519: 
                   15520: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   15521:     foreach my $option ('interface','localpath','localres') {
                   15522:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 15523:     }
                   15524: # --------------------------------------------------------- Write first profile
                   15525: 
                   15526:     {
                   15527: 	my %initial_env = 
                   15528: 	    ("user.name"          => $username,
                   15529: 	     "user.domain"        => $domain,
                   15530: 	     "user.home"          => $authhost,
                   15531: 	     "browser.type"       => $clientbrowser,
                   15532: 	     "browser.version"    => $clientversion,
                   15533: 	     "browser.mathml"     => $clientmathml,
                   15534: 	     "browser.unicode"    => $clientunicode,
                   15535: 	     "browser.os"         => $clientos,
1.1137    raeburn  15536:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  15537:              "browser.info"       => $clientinfo,
1.1194    raeburn  15538:              "browser.osversion"  => $clientosversion,
1.462     albertel 15539: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   15540: 	     "request.course.fn"  => '',
                   15541: 	     "request.course.uri" => '',
                   15542: 	     "request.course.sec" => '',
                   15543: 	     "request.role"       => 'cm',
                   15544: 	     "request.role.adv"   => $env{'user.adv'},
                   15545: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   15546: 
                   15547:         if ($form->{'localpath'}) {
                   15548: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   15549: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   15550:         }
                   15551: 	
                   15552: 	if ($form->{'interface'}) {
                   15553: 	    $form->{'interface'}=~s/\W//gs;
                   15554: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   15555: 	    $env{'browser.interface'}=$form->{'interface'};
                   15556: 	}
                   15557: 
1.1157    raeburn  15558:         if ($form->{'iptoken'}) {
                   15559:             my $lonhost = $r->dir_config('lonHostID');
                   15560:             $initial_env{"user.noloadbalance"} = $lonhost;
                   15561:             $env{'user.noloadbalance'} = $lonhost;
                   15562:         }
                   15563: 
1.981     raeburn  15564:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  15565:         my %domdef;
                   15566:         unless ($domain eq 'public') {
                   15567:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   15568:         }
1.980     raeburn  15569: 
1.1081    raeburn  15570:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  15571:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  15572:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   15573:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  15574:         }
                   15575: 
1.1237    raeburn  15576:         foreach my $crstype ('official','unofficial','community','textbook','placement') {
1.765     raeburn  15577:             $userenv{'canrequest.'.$crstype} =
                   15578:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  15579:                                                   'reload','requestcourses',
                   15580:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  15581:         }
                   15582: 
1.1092    raeburn  15583:         $userenv{'canrequest.author'} =
                   15584:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   15585:                                         'reload','requestauthor',
                   15586:                                         \%userenv,\%domdef,\%is_adv);
                   15587:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   15588:                                              $domain,$username);
                   15589:         my $reqstatus = $reqauthor{'author_status'};
                   15590:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   15591:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   15592:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   15593:                                                   $reqauthor{'author'}{'timestamp'};
                   15594:             }
                   15595:         }
                   15596: 
1.462     albertel 15597: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  15598: 
1.462     albertel 15599: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   15600: 		 &GDBM_WRCREAT(),0640)) {
                   15601: 	    &_add_to_env(\%disk_env,\%initial_env);
                   15602: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   15603: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  15604:             if (ref($firstaccenv) eq 'HASH') {
                   15605:                 &_add_to_env(\%disk_env,$firstaccenv);
                   15606:             }
                   15607:             if (ref($timerintenv) eq 'HASH') {
                   15608:                 &_add_to_env(\%disk_env,$timerintenv);
                   15609:             }
1.463     albertel 15610: 	    if (ref($args->{'extra_env'})) {
                   15611: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   15612: 	    }
1.462     albertel 15613: 	    untie(%disk_env);
                   15614: 	} else {
1.705     tempelho 15615: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   15616: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 15617: 	    return 'error: '.$!;
                   15618: 	}
                   15619:     }
                   15620:     $env{'request.role'}='cm';
                   15621:     $env{'request.role.adv'}=$env{'user.adv'};
                   15622:     $env{'browser.type'}=$clientbrowser;
                   15623: 
                   15624:     return $cookie;
                   15625: 
                   15626: }
                   15627: 
                   15628: sub _add_to_env {
                   15629:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  15630:     if (ref($env_data) eq 'HASH') {
                   15631:         while (my ($key,$value) = each(%$env_data)) {
                   15632: 	    $idf->{$prefix.$key} = $value;
                   15633: 	    $env{$prefix.$key}   = $value;
                   15634:         }
1.462     albertel 15635:     }
                   15636: }
                   15637: 
1.685     tempelho 15638: # --- Get the symbolic name of a problem and the url
                   15639: sub get_symb {
                   15640:     my ($request,$silent) = @_;
1.726     raeburn  15641:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 15642:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   15643:     if ($symb eq '') {
                   15644:         if (!$silent) {
1.1071    raeburn  15645:             if (ref($request)) { 
                   15646:                 $request->print("Unable to handle ambiguous references:$url:.");
                   15647:             }
1.685     tempelho 15648:             return ();
                   15649:         }
                   15650:     }
                   15651:     &Apache::lonenc::check_decrypt(\$symb);
                   15652:     return ($symb);
                   15653: }
                   15654: 
                   15655: # --------------------------------------------------------------Get annotation
                   15656: 
                   15657: sub get_annotation {
                   15658:     my ($symb,$enc) = @_;
                   15659: 
                   15660:     my $key = $symb;
                   15661:     if (!$enc) {
                   15662:         $key =
                   15663:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   15664:     }
                   15665:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   15666:     return $annotation{$key};
                   15667: }
                   15668: 
                   15669: sub clean_symb {
1.731     raeburn  15670:     my ($symb,$delete_enc) = @_;
1.685     tempelho 15671: 
                   15672:     &Apache::lonenc::check_decrypt(\$symb);
                   15673:     my $enc = $env{'request.enc'};
1.731     raeburn  15674:     if ($delete_enc) {
1.730     raeburn  15675:         delete($env{'request.enc'});
                   15676:     }
1.685     tempelho 15677: 
                   15678:     return ($symb,$enc);
                   15679: }
1.462     albertel 15680: 
1.1181    raeburn  15681: ############################################################
                   15682: ############################################################
                   15683: 
                   15684: =pod
                   15685: 
                   15686: =head1 Routines for building display used to search for courses
                   15687: 
                   15688: 
                   15689: =over 4
                   15690: 
                   15691: =item * &build_filters()
                   15692: 
                   15693: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  15694: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   15695: and quotacheck.pl
                   15696: 
1.1181    raeburn  15697: 
                   15698: Inputs:
                   15699: 
                   15700: filterlist - anonymous array of fields to include as potential filters 
                   15701: 
                   15702: crstype - course type
                   15703: 
                   15704: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   15705:               to pop-open a course selector (will contain "extra element"). 
                   15706: 
                   15707: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   15708: 
                   15709: filter - anonymous hash of criteria and their values
                   15710: 
                   15711: action - form action
                   15712: 
                   15713: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   15714: 
1.1182    raeburn  15715: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  15716: 
                   15717: cloneruname - username of owner of new course who wants to clone
                   15718: 
                   15719: clonerudom - domain of owner of new course who wants to clone
                   15720: 
                   15721: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   15722: 
                   15723: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   15724: 
                   15725: codedom - domain
                   15726: 
                   15727: formname - value of form element named "form". 
                   15728: 
                   15729: fixeddom - domain, if fixed.
                   15730: 
                   15731: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   15732: 
                   15733: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   15734: 
                   15735: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   15736: 
                   15737: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   15738: 
                   15739: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   15740: 
                   15741: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   15742: 
                   15743: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   15744: 
1.1182    raeburn  15745: 
1.1181    raeburn  15746: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   15747: 
1.1182    raeburn  15748: 
1.1181    raeburn  15749: Side Effects: None
                   15750: 
                   15751: =cut
                   15752: 
                   15753: # ---------------------------------------------- search for courses based on last activity etc.
                   15754: 
                   15755: sub build_filters {
                   15756:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   15757:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   15758:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   15759:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   15760:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  15761:     my ($list,$jscript);
1.1181    raeburn  15762:     my $onchange = 'javascript:updateFilters(this)';
                   15763:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   15764:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   15765:         $typeselectform,$instcodetitle);
                   15766:     if ($formname eq '') {
                   15767:         $formname = $caller;
                   15768:     }
                   15769:     foreach my $item (@{$filterlist}) {
                   15770:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   15771:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   15772:             if ($item eq 'domainfilter') {
                   15773:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   15774:             } elsif ($item eq 'coursefilter') {
                   15775:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   15776:             } elsif ($item eq 'ownerfilter') {
                   15777:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15778:             } elsif ($item eq 'ownerdomfilter') {
                   15779:                 $filter->{'ownerdomfilter'} =
                   15780:                     &LONCAPA::clean_domain($filter->{$item});
                   15781:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   15782:                                                        'ownerdomfilter',1);
                   15783:             } elsif ($item eq 'personfilter') {
                   15784:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15785:             } elsif ($item eq 'persondomfilter') {
                   15786:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   15787:                                                         'persondomfilter',1);
                   15788:             } else {
                   15789:                 $filter->{$item} =~ s/\W//g;
                   15790:             }
                   15791:             if (!$filter->{$item}) {
                   15792:                 $filter->{$item} = '';
                   15793:             }
                   15794:         }
                   15795:         if ($item eq 'domainfilter') {
                   15796:             my $allow_blank = 1;
                   15797:             if ($formname eq 'portform') {
                   15798:                 $allow_blank=0;
                   15799:             } elsif ($formname eq 'studentform') {
                   15800:                 $allow_blank=0;
                   15801:             }
                   15802:             if ($fixeddom) {
                   15803:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   15804:                                     ' value="'.$codedom.'" />'.
                   15805:                                     &Apache::lonnet::domain($codedom,'description');
                   15806:             } else {
                   15807:                 $domainselectform = &select_dom_form($filter->{$item},
                   15808:                                                      'domainfilter',
                   15809:                                                       $allow_blank,'',$onchange);
                   15810:             }
                   15811:         } else {
                   15812:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   15813:         }
                   15814:     }
                   15815: 
                   15816:     # last course activity filter and selection
                   15817:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   15818: 
                   15819:     # course created filter and selection
                   15820:     if (exists($filter->{'createdfilter'})) {
                   15821:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   15822:     }
                   15823: 
1.1239    raeburn  15824:     my $prefix = $crstype;
                   15825:     if ($crstype eq 'Placement') {
                   15826:         $prefix = 'Placement Test'
                   15827:     }
1.1181    raeburn  15828:     my %lt = &Apache::lonlocal::texthash(
1.1239    raeburn  15829:                 'cac' => "$prefix Activity",
                   15830:                 'ccr' => "$prefix Created",
                   15831:                 'cde' => "$prefix Title",
                   15832:                 'cdo' => "$prefix Domain",
1.1181    raeburn  15833:                 'ins' => 'Institutional Code',
                   15834:                 'inc' => 'Institutional Categorization',
1.1239    raeburn  15835:                 'cow' => "$prefix Owner/Co-owner",
                   15836:                 'cop' => "$prefix Personnel Includes",
1.1181    raeburn  15837:                 'cog' => 'Type',
                   15838:              );
                   15839: 
                   15840:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15841:         my $typeval = 'Course';
                   15842:         if ($crstype eq 'Community') {
                   15843:             $typeval = 'Community';
1.1239    raeburn  15844:         } elsif ($crstype eq 'Placement') {
                   15845:             $typeval = 'Placement';
1.1181    raeburn  15846:         }
                   15847:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   15848:     } else {
                   15849:         $typeselectform =  '<select name="type" size="1"';
                   15850:         if ($onchange) {
                   15851:             $typeselectform .= ' onchange="'.$onchange.'"';
                   15852:         }
                   15853:         $typeselectform .= '>'."\n";
1.1237    raeburn  15854:         foreach my $posstype ('Course','Community','Placement') {
1.1239    raeburn  15855:             my $shown;
                   15856:             if ($posstype eq 'Placement') {
                   15857:                 $shown = &mt('Placement Test');
                   15858:             } else {
                   15859:                 $shown = &mt($posstype);
                   15860:             }
1.1181    raeburn  15861:             $typeselectform.='<option value="'.$posstype.'"'.
1.1239    raeburn  15862:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181    raeburn  15863:         }
                   15864:         $typeselectform.="</select>";
                   15865:     }
                   15866: 
                   15867:     my ($cloneableonlyform,$cloneabletitle);
                   15868:     if (exists($filter->{'cloneableonly'})) {
                   15869:         my $cloneableon = '';
                   15870:         my $cloneableoff = ' checked="checked"';
                   15871:         if ($filter->{'cloneableonly'}) {
                   15872:             $cloneableon = $cloneableoff;
                   15873:             $cloneableoff = '';
                   15874:         }
                   15875:         $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>';
                   15876:         if ($formname eq 'ccrs') {
1.1187    bisitz   15877:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181    raeburn  15878:         } else {
                   15879:             $cloneabletitle = &mt('Cloneable by you');
                   15880:         }
                   15881:     }
                   15882:     my $officialjs;
                   15883:     if ($crstype eq 'Course') {
                   15884:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  15885: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   15886: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   15887:             if ($codedom) { 
1.1181    raeburn  15888:                 $officialjs = 1;
                   15889:                 ($instcodeform,$jscript,$$numtitlesref) =
                   15890:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   15891:                                                                   $officialjs,$codetitlesref);
                   15892:                 if ($jscript) {
1.1182    raeburn  15893:                     $jscript = '<script type="text/javascript">'."\n".
                   15894:                                '// <![CDATA['."\n".
                   15895:                                $jscript."\n".
                   15896:                                '// ]]>'."\n".
                   15897:                                '</script>'."\n";
1.1181    raeburn  15898:                 }
                   15899:             }
                   15900:             if ($instcodeform eq '') {
                   15901:                 $instcodeform =
                   15902:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   15903:                     $list->{'instcodefilter'}.'" />';
                   15904:                 $instcodetitle = $lt{'ins'};
                   15905:             } else {
                   15906:                 $instcodetitle = $lt{'inc'};
                   15907:             }
                   15908:             if ($fixeddom) {
                   15909:                 $instcodetitle .= '<br />('.$codedom.')';
                   15910:             }
                   15911:         }
                   15912:     }
                   15913:     my $output = qq|
                   15914: <form method="post" name="filterpicker" action="$action">
                   15915: <input type="hidden" name="form" value="$formname" />
                   15916: |;
                   15917:     if ($formname eq 'modifycourse') {
                   15918:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   15919:                    '<input type="hidden" name="prevphase" value="'.
                   15920:                    $prevphase.'" />'."\n";
1.1198    musolffc 15921:     } elsif ($formname eq 'quotacheck') {
                   15922:         $output .= qq|
                   15923: <input type="hidden" name="sortby" value="" />
                   15924: <input type="hidden" name="sortorder" value="" />
                   15925: |;
                   15926:     } else {
1.1181    raeburn  15927:         my $name_input;
                   15928:         if ($cnameelement ne '') {
                   15929:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   15930:                           $cnameelement.'" />';
                   15931:         }
                   15932:         $output .= qq|
1.1182    raeburn  15933: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   15934: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  15935: $name_input
                   15936: $roleelement
                   15937: $multelement
                   15938: $typeelement
                   15939: |;
                   15940:         if ($formname eq 'portform') {
                   15941:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   15942:         }
                   15943:     }
                   15944:     if ($fixeddom) {
                   15945:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   15946:     }
                   15947:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   15948:     if ($sincefilterform) {
                   15949:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   15950:                   .$sincefilterform
                   15951:                   .&Apache::lonhtmlcommon::row_closure();
                   15952:     }
                   15953:     if ($createdfilterform) {
                   15954:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   15955:                   .$createdfilterform
                   15956:                   .&Apache::lonhtmlcommon::row_closure();
                   15957:     }
                   15958:     if ($domainselectform) {
                   15959:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   15960:                   .$domainselectform
                   15961:                   .&Apache::lonhtmlcommon::row_closure();
                   15962:     }
                   15963:     if ($typeselectform) {
                   15964:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15965:             $output .= $typeselectform;
                   15966:         } else {
                   15967:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   15968:                       .$typeselectform
                   15969:                       .&Apache::lonhtmlcommon::row_closure();
                   15970:         }
                   15971:     }
                   15972:     if ($instcodeform) {
                   15973:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   15974:                   .$instcodeform
                   15975:                   .&Apache::lonhtmlcommon::row_closure();
                   15976:     }
                   15977:     if (exists($filter->{'ownerfilter'})) {
                   15978:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   15979:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15980:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   15981:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15982:                    $ownerdomselectform.'</td></tr></table>'.
                   15983:                    &Apache::lonhtmlcommon::row_closure();
                   15984:     }
                   15985:     if (exists($filter->{'personfilter'})) {
                   15986:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   15987:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15988:                    '<input type="text" name="personfilter" size="20" value="'.
                   15989:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15990:                    $persondomselectform.'</td></tr></table>'.
                   15991:                    &Apache::lonhtmlcommon::row_closure();
                   15992:     }
                   15993:     if (exists($filter->{'coursefilter'})) {
                   15994:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   15995:                   .'<input type="text" name="coursefilter" size="25" value="'
                   15996:                   .$list->{'coursefilter'}.'" />'
                   15997:                   .&Apache::lonhtmlcommon::row_closure();
                   15998:     }
                   15999:     if ($cloneableonlyform) {
                   16000:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   16001:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   16002:     }
                   16003:     if (exists($filter->{'descriptfilter'})) {
                   16004:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   16005:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   16006:                   .$list->{'descriptfilter'}.'" />'
                   16007:                   .&Apache::lonhtmlcommon::row_closure(1);
                   16008:     }
                   16009:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   16010:                '<input type="hidden" name="updater" value="" />'."\n".
                   16011:                '<input type="submit" name="gosearch" value="'.
                   16012:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   16013:     return $jscript.$clonewarning.$output;
                   16014: }
                   16015: 
                   16016: =pod 
                   16017: 
                   16018: =item * &timebased_select_form()
                   16019: 
1.1182    raeburn  16020: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  16021: filter e.g., Course Activity, Course Created, when searching for courses
                   16022: or communities
                   16023: 
                   16024: Inputs:
                   16025: 
                   16026: item - name of form element (sincefilter or createdfilter)
                   16027: 
                   16028: filter - anonymous hash of criteria and their values
                   16029: 
                   16030: Returns: HTML for a select box contained a blank, then six time selections,
                   16031:          with value set in incoming form variables currently selected. 
                   16032: 
                   16033: Side Effects: None
                   16034: 
                   16035: =cut
                   16036: 
                   16037: sub timebased_select_form {
                   16038:     my ($item,$filter) = @_;
                   16039:     if (ref($filter) eq 'HASH') {
                   16040:         $filter->{$item} =~ s/[^\d-]//g;
                   16041:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   16042:         return &select_form(
                   16043:                             $filter->{$item},
                   16044:                             $item,
                   16045:                             {      '-1' => '',
                   16046:                                 '86400' => &mt('today'),
                   16047:                                '604800' => &mt('last week'),
                   16048:                               '2592000' => &mt('last month'),
                   16049:                               '7776000' => &mt('last three months'),
                   16050:                              '15552000' => &mt('last six months'),
                   16051:                              '31104000' => &mt('last year'),
                   16052:                     'select_form_order' =>
                   16053:                            ['-1','86400','604800','2592000','7776000',
                   16054:                             '15552000','31104000']});
                   16055:     }
                   16056: }
                   16057: 
                   16058: =pod
                   16059: 
                   16060: =item * &js_changer()
                   16061: 
                   16062: Create script tag containing Javascript used to submit course search form
1.1183    raeburn  16063: when course type or domain is changed, and also to hide 'Searching ...' on
                   16064: page load completion for page showing search result.
1.1181    raeburn  16065: 
                   16066: Inputs: None
                   16067: 
1.1183    raeburn  16068: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  16069: 
                   16070: Side Effects: None
                   16071: 
                   16072: =cut
                   16073: 
                   16074: sub js_changer {
                   16075:     return <<ENDJS;
                   16076: <script type="text/javascript">
                   16077: // <![CDATA[
                   16078: function updateFilters(caller) {
                   16079:     if (typeof(caller) != "undefined") {
                   16080:         document.filterpicker.updater.value = caller.name;
                   16081:     }
                   16082:     document.filterpicker.submit();
                   16083: }
1.1183    raeburn  16084: 
                   16085: function hideSearching() {
                   16086:     if (document.getElementById('searching')) {
                   16087:         document.getElementById('searching').style.display = 'none';
                   16088:     }
                   16089:     return;
                   16090: }
                   16091: 
1.1181    raeburn  16092: // ]]>
                   16093: </script>
                   16094: 
                   16095: ENDJS
                   16096: }
                   16097: 
                   16098: =pod
                   16099: 
1.1182    raeburn  16100: =item * &search_courses()
                   16101: 
                   16102: Process selected filters form course search form and pass to lonnet::courseiddump
                   16103: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   16104: 
                   16105: Inputs:
                   16106: 
                   16107: dom - domain being searched 
                   16108: 
                   16109: type - course type ('Course' or 'Community' or '.' if any).
                   16110: 
                   16111: filter - anonymous hash of criteria and their values
                   16112: 
                   16113: numtitles - for institutional codes - number of categories
                   16114: 
                   16115: cloneruname - optional username of new course owner
                   16116: 
                   16117: clonerudom - optional domain of new course owner
                   16118: 
1.1221    raeburn  16119: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
1.1182    raeburn  16120:             (used when DC is using course creation form)
                   16121: 
                   16122: codetitles - reference to array of titles of components in institutional codes (official courses).
                   16123: 
1.1221    raeburn  16124: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   16125:            (and so can clone automatically)
                   16126: 
                   16127: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   16128: 
                   16129: reqinstcode - institutional code of new course, where search_courses is used to identify potential 
                   16130:               courses to clone 
1.1182    raeburn  16131: 
                   16132: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   16133: 
                   16134: 
                   16135: Side Effects: None
                   16136: 
                   16137: =cut
                   16138: 
                   16139: 
                   16140: sub search_courses {
1.1221    raeburn  16141:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   16142:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182    raeburn  16143:     my (%courses,%showcourses,$cloner);
                   16144:     if (($filter->{'ownerfilter'} ne '') ||
                   16145:         ($filter->{'ownerdomfilter'} ne '')) {
                   16146:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   16147:                                        $filter->{'ownerdomfilter'};
                   16148:     }
                   16149:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   16150:         if (!$filter->{$item}) {
                   16151:             $filter->{$item}='.';
                   16152:         }
                   16153:     }
                   16154:     my $now = time;
                   16155:     my $timefilter =
                   16156:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   16157:     my ($createdbefore,$createdafter);
                   16158:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   16159:         $createdbefore = $now;
                   16160:         $createdafter = $now-$filter->{'createdfilter'};
                   16161:     }
                   16162:     my ($instcodefilter,$regexpok);
                   16163:     if ($numtitles) {
                   16164:         if ($env{'form.official'} eq 'on') {
                   16165:             $instcodefilter =
                   16166:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16167:             $regexpok = 1;
                   16168:         } elsif ($env{'form.official'} eq 'off') {
                   16169:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16170:             unless ($instcodefilter eq '') {
                   16171:                 $regexpok = -1;
                   16172:             }
                   16173:         }
                   16174:     } else {
                   16175:         $instcodefilter = $filter->{'instcodefilter'};
                   16176:     }
                   16177:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   16178:     if ($type eq '') { $type = '.'; }
                   16179: 
                   16180:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   16181:         $cloner = $cloneruname.':'.$clonerudom;
                   16182:     }
                   16183:     %courses = &Apache::lonnet::courseiddump($dom,
                   16184:                                              $filter->{'descriptfilter'},
                   16185:                                              $timefilter,
                   16186:                                              $instcodefilter,
                   16187:                                              $filter->{'combownerfilter'},
                   16188:                                              $filter->{'coursefilter'},
                   16189:                                              undef,undef,$type,$regexpok,undef,undef,
1.1221    raeburn  16190:                                              undef,undef,$cloner,$cc_clone,
1.1182    raeburn  16191:                                              $filter->{'cloneableonly'},
                   16192:                                              $createdbefore,$createdafter,undef,
1.1221    raeburn  16193:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182    raeburn  16194:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   16195:         my $ccrole;
                   16196:         if ($type eq 'Community') {
                   16197:             $ccrole = 'co';
                   16198:         } else {
                   16199:             $ccrole = 'cc';
                   16200:         }
                   16201:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   16202:                                                      $filter->{'persondomfilter'},
                   16203:                                                      'userroles',undef,
                   16204:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   16205:                                                      $dom);
                   16206:         foreach my $role (keys(%rolehash)) {
                   16207:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   16208:             my $cid = $cdom.'_'.$cnum;
                   16209:             if (exists($courses{$cid})) {
                   16210:                 if (ref($courses{$cid}) eq 'HASH') {
                   16211:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   16212:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   16213:                             push (@{$courses{$cid}{roles}},$courserole);
                   16214:                         }
                   16215:                     } else {
                   16216:                         $courses{$cid}{roles} = [$courserole];
                   16217:                     }
                   16218:                     $showcourses{$cid} = $courses{$cid};
                   16219:                 }
                   16220:             }
                   16221:         }
                   16222:         %courses = %showcourses;
                   16223:     }
                   16224:     return %courses;
                   16225: }
                   16226: 
                   16227: =pod
                   16228: 
1.1181    raeburn  16229: =back
                   16230: 
1.1207    raeburn  16231: =head1 Routines for version requirements for current course.
                   16232: 
                   16233: =over 4
                   16234: 
                   16235: =item * &check_release_required()
                   16236: 
                   16237: Compares required LON-CAPA version with version on server, and
                   16238: if required version is newer looks for a server with the required version.
                   16239: 
                   16240: Looks first at servers in user's owen domain; if none suitable, looks at
                   16241: servers in course's domain are permitted to host sessions for user's domain.
                   16242: 
                   16243: Inputs:
                   16244: 
                   16245: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16246: 
                   16247: $courseid - Course ID of current course
                   16248: 
                   16249: $rolecode - User's current role in course (for switchserver query string).
                   16250: 
                   16251: $required - LON-CAPA version needed by course (format: Major.Minor).
                   16252: 
                   16253: 
                   16254: Returns:
                   16255: 
                   16256: $switchserver - query string tp append to /adm/switchserver call (if 
                   16257:                 current server's LON-CAPA version is too old. 
                   16258: 
                   16259: $warning - Message is displayed if no suitable server could be found.
                   16260: 
                   16261: =cut
                   16262: 
                   16263: sub check_release_required {
                   16264:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   16265:     my ($switchserver,$warning);
                   16266:     if ($required ne '') {
                   16267:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   16268:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16269:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   16270:             my $otherserver;
                   16271:             if (($major eq '' && $minor eq '') ||
                   16272:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   16273:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   16274:                 my $switchlcrev =
                   16275:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   16276:                                                            $userdomserver);
                   16277:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16278:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   16279:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   16280:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   16281:                     if ($cdom ne $env{'user.domain'}) {
                   16282:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   16283:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   16284:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16285:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   16286:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   16287:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   16288:                         my $canhost =
                   16289:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   16290:                                                               $coursedomserver,
                   16291:                                                               $remoterev,
                   16292:                                                               $udomdefaults{'remotesessions'},
                   16293:                                                               $defdomdefaults{'hostedsessions'});
                   16294: 
                   16295:                         if ($canhost) {
                   16296:                             $otherserver = $coursedomserver;
                   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 either your own domain or in the course's domain.");
                   16299:                         }
                   16300:                     } else {
                   16301:                         $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).");
                   16302:                     }
                   16303:                 } else {
                   16304:                     $otherserver = $userdomserver;
                   16305:                 }
                   16306:             }
                   16307:             if ($otherserver ne '') {
                   16308:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   16309:             }
                   16310:         }
                   16311:     }
                   16312:     return ($switchserver,$warning);
                   16313: }
                   16314: 
                   16315: =pod
                   16316: 
                   16317: =item * &check_release_result()
                   16318: 
                   16319: Inputs:
                   16320: 
                   16321: $switchwarning - Warning message if no suitable server found to host session.
                   16322: 
                   16323: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16324:                 and current role.
                   16325: 
                   16326: Returns: HTML to display with information about requirement to switch server.
                   16327:          Either displaying warning with link to Roles/Courses screen or
                   16328:          display link to switchserver.
                   16329: 
1.1181    raeburn  16330: =cut
                   16331: 
1.1207    raeburn  16332: sub check_release_result {
                   16333:     my ($switchwarning,$switchserver) = @_;
                   16334:     my $output = &start_page('Selected course unavailable on this server').
                   16335:                  '<p class="LC_warning">';
                   16336:     if ($switchwarning) {
                   16337:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   16338:         if (&show_course()) {
                   16339:             $output .= &mt('Display courses');
                   16340:         } else {
                   16341:             $output .= &mt('Display roles');
                   16342:         }
                   16343:         $output .= '</a>';
                   16344:     } elsif ($switchserver) {
                   16345:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   16346:                    '<br />'.
                   16347:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   16348:                    &mt('Switch Server').
                   16349:                    '</a>';
                   16350:     }
                   16351:     $output .= '</p>'.&end_page();
                   16352:     return $output;
                   16353: }
                   16354: 
                   16355: =pod
                   16356: 
                   16357: =item * &needs_coursereinit()
                   16358: 
                   16359: Determine if course contents stored for user's session needs to be
                   16360: refreshed, because content has changed since "Big Hash" last tied.
                   16361: 
                   16362: Check for change is made if time last checked is more than 10 minutes ago
                   16363: (by default).
                   16364: 
                   16365: Inputs:
                   16366: 
                   16367: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16368: 
                   16369: $interval (optional) - Time which may elapse (in s) between last check for content
                   16370:                        change in current course. (default: 600 s).  
                   16371: 
                   16372: Returns: an array; first element is:
                   16373: 
                   16374: =over 4
                   16375: 
                   16376: 'switch' - if content updates mean user's session
                   16377:            needs to be switched to a server running a newer LON-CAPA version
                   16378:  
                   16379: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   16380:            on current server hosting user's session                
                   16381: 
                   16382: ''       - if no action required.
                   16383: 
                   16384: =back
                   16385: 
                   16386: If first item element is 'switch':
                   16387: 
                   16388: second item is $switchwarning - Warning message if no suitable server found to host session. 
                   16389: 
                   16390: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16391:                               and current role. 
                   16392: 
                   16393: otherwise: no other elements returned.
                   16394: 
                   16395: =back
                   16396: 
                   16397: =cut
                   16398: 
                   16399: sub needs_coursereinit {
                   16400:     my ($loncaparev,$interval) = @_;
                   16401:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   16402:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   16403:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   16404:     my $now = time;
                   16405:     if ($interval eq '') {
                   16406:         $interval = 600;
                   16407:     }
                   16408:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   16409:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16410:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                   16411:         if ($lastchange > $env{'request.course.tied'}) {
                   16412:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16413:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   16414:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   16415:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   16416:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   16417:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   16418:                     my ($switchserver,$switchwarning) =
                   16419:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   16420:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   16421:                     if ($switchwarning ne '' || $switchserver ne '') {
                   16422:                         return ('switch',$switchwarning,$switchserver);
                   16423:                     }
                   16424:                 }
                   16425:             }
                   16426:             return ('update');
                   16427:         }
                   16428:     }
                   16429:     return ();
                   16430: }
1.1181    raeburn  16431: 
1.1083    raeburn  16432: sub update_content_constraints {
                   16433:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16434:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16435:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   16436:     my %checkresponsetypes;
                   16437:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236    raeburn  16438:         my ($item,$name,$value) = split(/:/,$key);
1.1083    raeburn  16439:         if ($item eq 'resourcetag') {
                   16440:             if ($name eq 'responsetype') {
                   16441:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   16442:             }
                   16443:         }
                   16444:     }
                   16445:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16446:     if (defined($navmap)) {
                   16447:         my %allresponses;
                   16448:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   16449:             my %responses = $res->responseTypes();
                   16450:             foreach my $key (keys(%responses)) {
                   16451:                 next unless(exists($checkresponsetypes{$key}));
                   16452:                 $allresponses{$key} += $responses{$key};
                   16453:             }
                   16454:         }
                   16455:         foreach my $key (keys(%allresponses)) {
                   16456:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   16457:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   16458:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   16459:             }
                   16460:         }
                   16461:         undef($navmap);
                   16462:     }
                   16463:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   16464:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   16465:     }
                   16466:     return;
                   16467: }
                   16468: 
1.1110    raeburn  16469: sub allmaps_incourse {
                   16470:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16471:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   16472:         $cid = $env{'request.course.id'};
                   16473:         $cdom = $env{'course.'.$cid.'.domain'};
                   16474:         $cnum = $env{'course.'.$cid.'.num'};
                   16475:         $chome = $env{'course.'.$cid.'.home'};
                   16476:     }
                   16477:     my %allmaps = ();
                   16478:     my $lastchange =
                   16479:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16480:     if ($lastchange > $env{'request.course.tied'}) {
                   16481:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   16482:         unless ($ferr) {
                   16483:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   16484:         }
                   16485:     }
                   16486:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16487:     if (defined($navmap)) {
                   16488:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   16489:             $allmaps{$res->src()} = 1;
                   16490:         }
                   16491:     }
                   16492:     return \%allmaps;
                   16493: }
                   16494: 
1.1083    raeburn  16495: sub parse_supplemental_title {
                   16496:     my ($title) = @_;
                   16497: 
                   16498:     my ($foldertitle,$renametitle);
                   16499:     if ($title =~ /&amp;&amp;&amp;/) {
                   16500:         $title = &HTML::Entites::decode($title);
                   16501:     }
                   16502:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   16503:         $renametitle=$4;
                   16504:         my ($time,$uname,$udom) = ($1,$2,$3);
                   16505:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   16506:         my $name =  &plainname($uname,$udom);
                   16507:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   16508:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   16509:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   16510:             $name.': <br />'.$foldertitle;
                   16511:     }
                   16512:     if (wantarray) {
                   16513:         return ($title,$foldertitle,$renametitle);
                   16514:     }
                   16515:     return $title;
                   16516: }
                   16517: 
1.1143    raeburn  16518: sub recurse_supplemental {
                   16519:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   16520:     if ($suppmap) {
                   16521:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   16522:         if ($fatal) {
                   16523:             $errors ++;
                   16524:         } else {
                   16525:             if ($#LONCAPA::map::resources > 0) {
                   16526:                 foreach my $res (@LONCAPA::map::resources) {
                   16527:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   16528:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  16529:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   16530:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  16531:                         } else {
                   16532:                             $numfiles ++;
                   16533:                         }
                   16534:                     }
                   16535:                 }
                   16536:             }
                   16537:         }
                   16538:     }
                   16539:     return ($numfiles,$errors);
                   16540: }
                   16541: 
1.1101    raeburn  16542: sub symb_to_docspath {
                   16543:     my ($symb) = @_;
                   16544:     return unless ($symb);
                   16545:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   16546:     if ($resurl=~/\.(sequence|page)$/) {
                   16547:         $mapurl=$resurl;
                   16548:     } elsif ($resurl eq 'adm/navmaps') {
                   16549:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   16550:     }
                   16551:     my $mapresobj;
                   16552:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16553:     if (ref($navmap)) {
                   16554:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   16555:     }
                   16556:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   16557:     my $type=$2;
                   16558:     my $path;
                   16559:     if (ref($mapresobj)) {
                   16560:         my $pcslist = $mapresobj->map_hierarchy();
                   16561:         if ($pcslist ne '') {
                   16562:             foreach my $pc (split(/,/,$pcslist)) {
                   16563:                 next if ($pc <= 1);
                   16564:                 my $res = $navmap->getByMapPc($pc);
                   16565:                 if (ref($res)) {
                   16566:                     my $thisurl = $res->src();
                   16567:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   16568:                     my $thistitle = $res->title();
                   16569:                     $path .= '&'.
                   16570:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  16571:                              &escape($thistitle).
1.1101    raeburn  16572:                              ':'.$res->randompick().
                   16573:                              ':'.$res->randomout().
                   16574:                              ':'.$res->encrypted().
                   16575:                              ':'.$res->randomorder().
                   16576:                              ':'.$res->is_page();
                   16577:                 }
                   16578:             }
                   16579:         }
                   16580:         $path =~ s/^\&//;
                   16581:         my $maptitle = $mapresobj->title();
                   16582:         if ($mapurl eq 'default') {
1.1129    raeburn  16583:             $maptitle = 'Main Content';
1.1101    raeburn  16584:         }
                   16585:         $path .= (($path ne '')? '&' : '').
                   16586:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16587:                  &escape($maptitle).
1.1101    raeburn  16588:                  ':'.$mapresobj->randompick().
                   16589:                  ':'.$mapresobj->randomout().
                   16590:                  ':'.$mapresobj->encrypted().
                   16591:                  ':'.$mapresobj->randomorder().
                   16592:                  ':'.$mapresobj->is_page();
                   16593:     } else {
                   16594:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   16595:         my $ispage = (($type eq 'page')? 1 : '');
                   16596:         if ($mapurl eq 'default') {
1.1129    raeburn  16597:             $maptitle = 'Main Content';
1.1101    raeburn  16598:         }
                   16599:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16600:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  16601:     }
                   16602:     unless ($mapurl eq 'default') {
                   16603:         $path = 'default&'.
1.1146    raeburn  16604:                 &escape('Main Content').
1.1101    raeburn  16605:                 ':::::&'.$path;
                   16606:     }
                   16607:     return $path;
                   16608: }
                   16609: 
1.1094    raeburn  16610: sub captcha_display {
                   16611:     my ($context,$lonhost) = @_;
                   16612:     my ($output,$error);
1.1234    raeburn  16613:     my ($captcha,$pubkey,$privkey,$version) = 
                   16614:         &get_captcha_config($context,$lonhost);
1.1095    raeburn  16615:     if ($captcha eq 'original') {
1.1094    raeburn  16616:         $output = &create_captcha();
                   16617:         unless ($output) {
1.1172    raeburn  16618:             $error = 'captcha';
1.1094    raeburn  16619:         }
                   16620:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  16621:         $output = &create_recaptcha($pubkey,$version);
1.1094    raeburn  16622:         unless ($output) {
1.1172    raeburn  16623:             $error = 'recaptcha';
1.1094    raeburn  16624:         }
                   16625:     }
1.1234    raeburn  16626:     return ($output,$error,$captcha,$version);
1.1094    raeburn  16627: }
                   16628: 
                   16629: sub captcha_response {
                   16630:     my ($context,$lonhost) = @_;
                   16631:     my ($captcha_chk,$captcha_error);
1.1234    raeburn  16632:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  16633:     if ($captcha eq 'original') {
1.1094    raeburn  16634:         ($captcha_chk,$captcha_error) = &check_captcha();
                   16635:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  16636:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1094    raeburn  16637:     } else {
                   16638:         $captcha_chk = 1;
                   16639:     }
                   16640:     return ($captcha_chk,$captcha_error);
                   16641: }
                   16642: 
                   16643: sub get_captcha_config {
                   16644:     my ($context,$lonhost) = @_;
1.1234    raeburn  16645:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094    raeburn  16646:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   16647:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   16648:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  16649:     if ($context eq 'usercreation') {
                   16650:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   16651:         if (ref($domconfig{$context}) eq 'HASH') {
                   16652:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   16653:             if (ref($hashtocheck) eq 'HASH') {
                   16654:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   16655:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   16656:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   16657:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   16658:                     }
                   16659:                     if ($privkey && $pubkey) {
                   16660:                         $captcha = 'recaptcha';
1.1234    raeburn  16661:                         $version = $hashtocheck->{'recaptchaversion'};
                   16662:                         if ($version ne '2') {
                   16663:                             $version = 1;
                   16664:                         }
1.1095    raeburn  16665:                     } else {
                   16666:                         $captcha = 'original';
                   16667:                     }
                   16668:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   16669:                     $captcha = 'original';
                   16670:                 }
1.1094    raeburn  16671:             }
1.1095    raeburn  16672:         } else {
                   16673:             $captcha = 'captcha';
                   16674:         }
                   16675:     } elsif ($context eq 'login') {
                   16676:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   16677:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   16678:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   16679:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  16680:             if ($privkey && $pubkey) {
                   16681:                 $captcha = 'recaptcha';
1.1234    raeburn  16682:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   16683:                 if ($version ne '2') {
                   16684:                     $version = 1; 
                   16685:                 }
1.1095    raeburn  16686:             } else {
                   16687:                 $captcha = 'original';
1.1094    raeburn  16688:             }
1.1095    raeburn  16689:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   16690:             $captcha = 'original';
1.1094    raeburn  16691:         }
                   16692:     }
1.1234    raeburn  16693:     return ($captcha,$pubkey,$privkey,$version);
1.1094    raeburn  16694: }
                   16695: 
                   16696: sub create_captcha {
                   16697:     my %captcha_params = &captcha_settings();
                   16698:     my ($output,$maxtries,$tries) = ('',10,0);
                   16699:     while ($tries < $maxtries) {
                   16700:         $tries ++;
                   16701:         my $captcha = Authen::Captcha->new (
                   16702:                                            output_folder => $captcha_params{'output_dir'},
                   16703:                                            data_folder   => $captcha_params{'db_dir'},
                   16704:                                           );
                   16705:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   16706: 
                   16707:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   16708:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   16709:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1176    raeburn  16710:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   16711:                       '<br />'.
                   16712:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  16713:             last;
                   16714:         }
                   16715:     }
                   16716:     return $output;
                   16717: }
                   16718: 
                   16719: sub captcha_settings {
                   16720:     my %captcha_params = (
                   16721:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   16722:                            www_output_dir => "/captchaspool",
                   16723:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   16724:                            numchars       => '5',
                   16725:                          );
                   16726:     return %captcha_params;
                   16727: }
                   16728: 
                   16729: sub check_captcha {
                   16730:     my ($captcha_chk,$captcha_error);
                   16731:     my $code = $env{'form.code'};
                   16732:     my $md5sum = $env{'form.crypt'};
                   16733:     my %captcha_params = &captcha_settings();
                   16734:     my $captcha = Authen::Captcha->new(
                   16735:                       output_folder => $captcha_params{'output_dir'},
                   16736:                       data_folder   => $captcha_params{'db_dir'},
                   16737:                   );
1.1109    raeburn  16738:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  16739:     my %captcha_hash = (
                   16740:                         0       => 'Code not checked (file error)',
                   16741:                        -1      => 'Failed: code expired',
                   16742:                        -2      => 'Failed: invalid code (not in database)',
                   16743:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   16744:     );
                   16745:     if ($captcha_chk != 1) {
                   16746:         $captcha_error = $captcha_hash{$captcha_chk}
                   16747:     }
                   16748:     return ($captcha_chk,$captcha_error);
                   16749: }
                   16750: 
                   16751: sub create_recaptcha {
1.1234    raeburn  16752:     my ($pubkey,$version) = @_;
                   16753:     if ($version >= 2) {
                   16754:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
                   16755:     } else {
                   16756:         my $use_ssl;
                   16757:         if ($ENV{'SERVER_PORT'} == 443) {
                   16758:             $use_ssl = 1;
                   16759:         }
                   16760:         my $captcha = Captcha::reCAPTCHA->new;
                   16761:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   16762:                $captcha->get_html($pubkey,undef,$use_ssl).
                   16763:                &mt('If the text is hard to read, [_1] will replace them.',
                   16764:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   16765:                '<br /><br />';
                   16766:     }
1.1094    raeburn  16767: }
                   16768: 
                   16769: sub check_recaptcha {
1.1234    raeburn  16770:     my ($privkey,$version) = @_;
1.1094    raeburn  16771:     my $captcha_chk;
1.1234    raeburn  16772:     if ($version >= 2) {
                   16773:         my $ua = LWP::UserAgent->new;
                   16774:         $ua->timeout(10);
                   16775:         my %info = (
                   16776:                      secret   => $privkey, 
                   16777:                      response => $env{'form.g-recaptcha-response'},
                   16778:                      remoteip => $ENV{'REMOTE_ADDR'},
                   16779:                    );
                   16780:         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
                   16781:         if ($response->is_success)  {
                   16782:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   16783:             if (ref($data) eq 'HASH') {
                   16784:                 if ($data->{'success'}) {
                   16785:                     $captcha_chk = 1;
                   16786:                 }
                   16787:             }
                   16788:         }
                   16789:     } else {
                   16790:         my $captcha = Captcha::reCAPTCHA->new;
                   16791:         my $captcha_result =
                   16792:             $captcha->check_answer(
                   16793:                                     $privkey,
                   16794:                                     $ENV{'REMOTE_ADDR'},
                   16795:                                     $env{'form.recaptcha_challenge_field'},
                   16796:                                     $env{'form.recaptcha_response_field'},
                   16797:                                   );
                   16798:         if ($captcha_result->{is_valid}) {
                   16799:             $captcha_chk = 1;
                   16800:         }
1.1094    raeburn  16801:     }
                   16802:     return $captcha_chk;
                   16803: }
                   16804: 
1.1174    raeburn  16805: sub emailusername_info {
1.1244    raeburn  16806:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174    raeburn  16807:     my %titles = &Apache::lonlocal::texthash (
                   16808:                      lastname      => 'Last Name',
                   16809:                      firstname     => 'First Name',
                   16810:                      institution   => 'School/college/university',
                   16811:                      location      => "School's city, state/province, country",
                   16812:                      web           => "School's web address",
                   16813:                      officialemail => 'E-mail address at institution (if different)',
1.1244    raeburn  16814:                      id            => 'Student/Employee ID',
1.1174    raeburn  16815:                  );
                   16816:     return (\@fields,\%titles);
                   16817: }
                   16818: 
1.1161    raeburn  16819: sub cleanup_html {
                   16820:     my ($incoming) = @_;
                   16821:     my $outgoing;
                   16822:     if ($incoming ne '') {
                   16823:         $outgoing = $incoming;
                   16824:         $outgoing =~ s/;/&#059;/g;
                   16825:         $outgoing =~ s/\#/&#035;/g;
                   16826:         $outgoing =~ s/\&/&#038;/g;
                   16827:         $outgoing =~ s/</&#060;/g;
                   16828:         $outgoing =~ s/>/&#062;/g;
                   16829:         $outgoing =~ s/\(/&#040/g;
                   16830:         $outgoing =~ s/\)/&#041;/g;
                   16831:         $outgoing =~ s/"/&#034;/g;
                   16832:         $outgoing =~ s/'/&#039;/g;
                   16833:         $outgoing =~ s/\$/&#036;/g;
                   16834:         $outgoing =~ s{/}{&#047;}g;
                   16835:         $outgoing =~ s/=/&#061;/g;
                   16836:         $outgoing =~ s/\\/&#092;/g
                   16837:     }
                   16838:     return $outgoing;
                   16839: }
                   16840: 
1.1190    musolffc 16841: # Checks for critical messages and returns a redirect url if one exists.
                   16842: # $interval indicates how often to check for messages.
                   16843: sub critical_redirect {
                   16844:     my ($interval) = @_;
                   16845:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   16846:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                   16847:                                         $env{'user.name'});
                   16848:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191    raeburn  16849:         my $redirecturl;
1.1190    musolffc 16850:         if ($what[0]) {
                   16851: 	    if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   16852: 	        $redirecturl='/adm/email?critical=display';
1.1191    raeburn  16853: 	        my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   16854:                 return (1, $url);
1.1190    musolffc 16855:             }
1.1191    raeburn  16856:         }
                   16857:     } 
                   16858:     return ();
1.1190    musolffc 16859: }
                   16860: 
1.1174    raeburn  16861: # Use:
                   16862: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   16863: #
                   16864: ##################################################
                   16865: #          password associated functions         #
                   16866: ##################################################
                   16867: sub des_keys {
                   16868:     # Make a new key for DES encryption.
                   16869:     # Each key has two parts which are returned separately.
                   16870:     # Please note:  Each key must be passed through the &hex function
                   16871:     # before it is output to the web browser.  The hex versions cannot
                   16872:     # be used to decrypt.
                   16873:     my @hexstr=('0','1','2','3','4','5','6','7',
                   16874:                 '8','9','a','b','c','d','e','f');
                   16875:     my $lkey='';
                   16876:     for (0..7) {
                   16877:         $lkey.=$hexstr[rand(15)];
                   16878:     }
                   16879:     my $ukey='';
                   16880:     for (0..7) {
                   16881:         $ukey.=$hexstr[rand(15)];
                   16882:     }
                   16883:     return ($lkey,$ukey);
                   16884: }
                   16885: 
                   16886: sub des_decrypt {
                   16887:     my ($key,$cyphertext) = @_;
                   16888:     my $keybin=pack("H16",$key);
                   16889:     my $cypher;
                   16890:     if ($Crypt::DES::VERSION>=2.03) {
                   16891:         $cypher=new Crypt::DES $keybin;
                   16892:     } else {
                   16893:         $cypher=new DES $keybin;
                   16894:     }
1.1233    raeburn  16895:     my $plaintext='';
                   16896:     my $cypherlength = length($cyphertext);
                   16897:     my $numchunks = int($cypherlength/32);
                   16898:     for (my $j=0; $j<$numchunks; $j++) {
                   16899:         my $start = $j*32;
                   16900:         my $cypherblock = substr($cyphertext,$start,32);
                   16901:         my $chunk =
                   16902:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   16903:         $chunk .=
                   16904:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   16905:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   16906:         $plaintext .= $chunk;
                   16907:     }
1.1174    raeburn  16908:     return $plaintext;
                   16909: }
                   16910: 
1.112     bowersj2 16911: 1;
                   16912: __END__;
1.41      ng       16913: 

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