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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1075.2.139! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.138 2019/08/25 22:56:14 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.1075.2.25  raeburn    70: use Apache::lonuserutils();
1.1075.2.27  raeburn    71: use Apache::lonuserstate();
1.1075.2.69  raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.1075.2.135  raeburn    74: use HTTP::Request;
1.657     raeburn    75: use DateTime::TimeZone;
1.1075.2.102  raeburn    76: use DateTime::Locale;
1.1075.2.94  raeburn    77: use Encode();
1.1075.2.14  raeburn    78: use Authen::Captcha;
                     79: use Captcha::reCAPTCHA;
1.1075.2.107  raeburn    80: use JSON::DWIW;
                     81: use LWP::UserAgent;
1.1075.2.64  raeburn    82: use Crypt::DES;
                     83: use DynaLoader; # for Crypt::DES version
1.1075.2.128  raeburn    84: use File::Copy();
                     85: use File::Path();
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.1048    foxr      170: my %latex_language;		# For choosing hyphenation in <transl..>
                    171: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  172: my %cprtag;
1.192     taceyjo1  173: my %scprtag;
1.351     www       174: my %fe; my %fd; my %fm;
1.41      ng        175: my %category_extensions;
1.12      harris41  176: 
1.46      matthew   177: # ---------------------------------------------- Thesaurus variables
1.144     matthew   178: #
                    179: # %Keywords:
                    180: #      A hash used by &keyword to determine if a word is considered a keyword.
                    181: # $thesaurus_db_file 
                    182: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   183: 
                    184: my %Keywords;
                    185: my $thesaurus_db_file;
                    186: 
1.144     matthew   187: #
                    188: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    189: # thesaurus.tab, and filecategories.tab.
                    190: #
1.18      www       191: BEGIN {
1.46      matthew   192:     # Variable initialization
                    193:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    194:     #
1.22      www       195:     unless ($readit) {
1.12      harris41  196: # ------------------------------------------------------------------- languages
                    197:     {
1.158     raeburn   198:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    199:                                    '/language.tab';
1.1075.2.128  raeburn   200:         if ( open(my $fh,'<',$langtabfile) ) {
1.356     albertel  201:             while (my $line = <$fh>) {
                    202:                 next if ($line=~/^\#/);
                    203:                 chomp($line);
1.1048    foxr      204:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   205:                 $language{$key}=$val.' - '.$enc;
                    206:                 if ($sup) {
                    207:                     $supported_language{$key}=$sup;
                    208:                 }
1.1048    foxr      209: 		if ($latex) {
                    210: 		    $latex_language_bykey{$key} = $latex;
                    211: 		    $latex_language{$two} = $latex;
                    212: 		}
1.158     raeburn   213:             }
                    214:             close($fh);
                    215:         }
1.12      harris41  216:     }
                    217: # ------------------------------------------------------------------ copyrights
                    218:     {
1.158     raeburn   219:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    220:                                   '/copyright.tab';
1.1075.2.128  raeburn   221:         if ( open (my $fh,'<',$copyrightfile) ) {
1.356     albertel  222:             while (my $line = <$fh>) {
                    223:                 next if ($line=~/^\#/);
                    224:                 chomp($line);
                    225:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   226:                 $cprtag{$key}=$val;
                    227:             }
                    228:             close($fh);
                    229:         }
1.12      harris41  230:     }
1.351     www       231: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  232:     {
                    233:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    234:                                   '/source_copyright.tab';
1.1075.2.128  raeburn   235:         if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356     albertel  236:             while (my $line = <$fh>) {
                    237:                 next if ($line =~ /^\#/);
                    238:                 chomp($line);
                    239:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  240:                 $scprtag{$key}=$val;
                    241:             }
                    242:             close($fh);
                    243:         }
                    244:     }
1.63      www       245: 
1.517     raeburn   246: # -------------------------------------------------------------- default domain designs
1.63      www       247:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   248:     my $designfile = $designdir.'/default.tab';
1.1075.2.128  raeburn   249:     if ( open (my $fh,'<',$designfile) ) {
1.517     raeburn   250:         while (my $line = <$fh>) {
                    251:             next if ($line =~ /^\#/);
                    252:             chomp($line);
                    253:             my ($key,$val)=(split(/\=/,$line));
                    254:             if ($val) { $defaultdesign{$key}=$val; }
                    255:         }
                    256:         close($fh);
1.63      www       257:     }
                    258: 
1.15      harris41  259: # ------------------------------------------------------------- file categories
                    260:     {
1.158     raeburn   261:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    262:                                   '/filecategories.tab';
1.1075.2.128  raeburn   263:         if ( open (my $fh,'<',$categoryfile) ) {
1.356     albertel  264: 	    while (my $line = <$fh>) {
                    265: 		next if ($line =~ /^\#/);
                    266: 		chomp($line);
                    267:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.1075.2.119  raeburn   268:                 push(@{$category_extensions{lc($category)}},$extension);
1.158     raeburn   269:             }
                    270:             close($fh);
                    271:         }
                    272: 
1.15      harris41  273:     }
1.12      harris41  274: # ------------------------------------------------------------------ file types
                    275:     {
1.158     raeburn   276:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    277:                '/filetypes.tab';
1.1075.2.128  raeburn   278:         if ( open (my $fh,'<',$typesfile) ) {
1.356     albertel  279:             while (my $line = <$fh>) {
                    280: 		next if ($line =~ /^\#/);
                    281: 		chomp($line);
                    282:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   283:                 if ($descr ne '') {
                    284:                     $fe{$ending}=lc($emb);
                    285:                     $fd{$ending}=$descr;
1.351     www       286:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   287:                 }
                    288:             }
                    289:             close($fh);
                    290:         }
1.12      harris41  291:     }
1.22      www       292:     &Apache::lonnet::logthis(
1.705     tempelho  293:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       294:     $readit=1;
1.46      matthew   295:     }  # end of unless($readit) 
1.32      matthew   296:     
                    297: }
1.112     bowersj2  298: 
1.42      matthew   299: ###############################################################
                    300: ##           HTML and Javascript Helper Functions            ##
                    301: ###############################################################
                    302: 
                    303: =pod 
                    304: 
1.112     bowersj2  305: =head1 HTML and Javascript Functions
1.42      matthew   306: 
1.112     bowersj2  307: =over 4
                    308: 
1.648     raeburn   309: =item * &browser_and_searcher_javascript()
1.112     bowersj2  310: 
                    311: X<browsing, javascript>X<searching, javascript>Returns a string
                    312: containing javascript with two functions, C<openbrowser> and
                    313: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    314: tags.
1.42      matthew   315: 
1.648     raeburn   316: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   317: 
                    318: inputs: formname, elementname, only, omit
                    319: 
                    320: formname and elementname indicate the name of the html form and name of
                    321: the element that the results of the browsing selection are to be placed in. 
                    322: 
                    323: Specifying 'only' will restrict the browser to displaying only files
1.185     www       324: with the given extension.  Can be a comma separated list.
1.42      matthew   325: 
                    326: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       327: with the given extension.  Can be a comma separated list.
1.42      matthew   328: 
1.648     raeburn   329: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   330: 
                    331: Inputs: formname, elementname
                    332: 
                    333: formname and elementname specify the name of the html form and the name
                    334: of the element the selection from the search results will be placed in.
1.542     raeburn   335: 
1.42      matthew   336: =cut
                    337: 
                    338: sub browser_and_searcher_javascript {
1.199     albertel  339:     my ($mode)=@_;
                    340:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  341:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   342:     return <<END;
1.219     albertel  343: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   344:     var editbrowser = null;
1.135     albertel  345:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       346:         var url = '$resurl/?';
1.42      matthew   347:         if (editbrowser == null) {
                    348:             url += 'launch=1&';
                    349:         }
                    350:         url += 'catalogmode=interactive&';
1.199     albertel  351:         url += 'mode=$mode&';
1.611     albertel  352:         url += 'inhibitmenu=yes&';
1.42      matthew   353:         url += 'form=' + formname + '&';
                    354:         if (only != null) {
                    355:             url += 'only=' + only + '&';
1.217     albertel  356:         } else {
                    357:             url += 'only=&';
                    358: 	}
1.42      matthew   359:         if (omit != null) {
                    360:             url += 'omit=' + omit + '&';
1.217     albertel  361:         } else {
                    362:             url += 'omit=&';
                    363: 	}
1.135     albertel  364:         if (titleelement != null) {
                    365:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  366:         } else {
                    367: 	    url += 'titleelement=&';
                    368: 	}
1.42      matthew   369:         url += 'element=' + elementname + '';
                    370:         var title = 'Browser';
1.435     albertel  371:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   372:         options += ',width=700,height=600';
                    373:         editbrowser = open(url,title,options,'1');
                    374:         editbrowser.focus();
                    375:     }
                    376:     var editsearcher;
1.135     albertel  377:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   378:         var url = '/adm/searchcat?';
                    379:         if (editsearcher == null) {
                    380:             url += 'launch=1&';
                    381:         }
                    382:         url += 'catalogmode=interactive&';
1.199     albertel  383:         url += 'mode=$mode&';
1.42      matthew   384:         url += 'form=' + formname + '&';
1.135     albertel  385:         if (titleelement != null) {
                    386:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  387:         } else {
                    388: 	    url += 'titleelement=&';
                    389: 	}
1.42      matthew   390:         url += 'element=' + elementname + '';
                    391:         var title = 'Search';
1.435     albertel  392:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   393:         options += ',width=700,height=600';
                    394:         editsearcher = open(url,title,options,'1');
                    395:         editsearcher.focus();
                    396:     }
1.219     albertel  397: // END LON-CAPA Internal -->
1.42      matthew   398: END
1.170     www       399: }
                    400: 
                    401: sub lastresurl {
1.258     albertel  402:     if ($env{'environment.lastresurl'}) {
                    403: 	return $env{'environment.lastresurl'}
1.170     www       404:     } else {
                    405: 	return '/res';
                    406:     }
                    407: }
                    408: 
                    409: sub storeresurl {
                    410:     my $resurl=&Apache::lonnet::clutter(shift);
                    411:     unless ($resurl=~/^\/res/) { return 0; }
                    412:     $resurl=~s/\/$//;
                    413:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   414:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       415:     return 1;
1.42      matthew   416: }
                    417: 
1.74      www       418: sub studentbrowser_javascript {
1.111     www       419:    unless (
1.258     albertel  420:             (($env{'request.course.id'}) && 
1.302     albertel  421:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    422: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    423: 					  '/'.$env{'request.course.sec'})
                    424: 	      ))
1.258     albertel  425:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       426:           ) { return ''; }  
1.74      www       427:    return (<<'ENDSTDBRW');
1.776     bisitz    428: <script type="text/javascript" language="Javascript">
1.824     bisitz    429: // <![CDATA[
1.74      www       430:     var stdeditbrowser;
1.999     www       431:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       432:         var url = '/adm/pickstudent?';
                    433:         var filter;
1.558     albertel  434: 	if (!ignorefilter) {
                    435: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    436: 	}
1.74      www       437:         if (filter != null) {
                    438:            if (filter != '') {
                    439:                url += 'filter='+filter+'&';
                    440: 	   }
                    441:         }
                    442:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       443:                                     '&udomelement='+udom+
                    444:                                     '&clicker='+clicker;
1.111     www       445: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   446:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       447:         var title = 'Student_Browser';
1.74      www       448:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    449:         options += ',width=700,height=600';
                    450:         stdeditbrowser = open(url,title,options,'1');
                    451:         stdeditbrowser.focus();
                    452:     }
1.824     bisitz    453: // ]]>
1.74      www       454: </script>
                    455: ENDSTDBRW
                    456: }
1.42      matthew   457: 
1.1003    www       458: sub resourcebrowser_javascript {
                    459:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       460:    return (<<'ENDRESBRW');
1.1003    www       461: <script type="text/javascript" language="Javascript">
                    462: // <![CDATA[
                    463:     var reseditbrowser;
1.1004    www       464:     function openresbrowser(formname,reslink) {
1.1005    www       465:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       466:         var title = 'Resource_Browser';
                    467:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       468:         options += ',width=700,height=500';
1.1004    www       469:         reseditbrowser = open(url,title,options,'1');
                    470:         reseditbrowser.focus();
1.1003    www       471:     }
                    472: // ]]>
                    473: </script>
1.1004    www       474: ENDRESBRW
1.1003    www       475: }
                    476: 
1.74      www       477: sub selectstudent_link {
1.999     www       478:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    479:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    480:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    481:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  482:    if ($env{'request.course.id'}) {  
1.302     albertel  483:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    484: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    485: 					'/'.$env{'request.course.sec'})) {
1.111     www       486: 	   return '';
                    487:        }
1.999     www       488:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   489:        if ($courseadvonly)  {
                    490:            $callargs .= ",'',1,1";
                    491:        }
                    492:        return '<span class="LC_nobreak">'.
                    493:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    494:               &mt('Select User').'</a></span>';
1.74      www       495:    }
1.258     albertel  496:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       497:        $callargs .= ",'',1"; 
1.793     raeburn   498:        return '<span class="LC_nobreak">'.
                    499:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    500:               &mt('Select User').'</a></span>';
1.111     www       501:    }
                    502:    return '';
1.91      www       503: }
                    504: 
1.1004    www       505: sub selectresource_link {
                    506:    my ($form,$reslink,$arg)=@_;
                    507:    
                    508:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    509:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    510:    unless ($env{'request.course.id'}) { return $arg; }
                    511:    return '<span class="LC_nobreak">'.
                    512:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    513:               $arg.'</a></span>';
                    514: }
                    515: 
                    516: 
                    517: 
1.653     raeburn   518: sub authorbrowser_javascript {
                    519:     return <<"ENDAUTHORBRW";
1.776     bisitz    520: <script type="text/javascript" language="JavaScript">
1.824     bisitz    521: // <![CDATA[
1.653     raeburn   522: var stdeditbrowser;
                    523: 
                    524: function openauthorbrowser(formname,udom) {
                    525:     var url = '/adm/pickauthor?';
                    526:     url += 'form='+formname+'&roledom='+udom;
                    527:     var title = 'Author_Browser';
                    528:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    529:     options += ',width=700,height=600';
                    530:     stdeditbrowser = open(url,title,options,'1');
                    531:     stdeditbrowser.focus();
                    532: }
                    533: 
1.824     bisitz    534: // ]]>
1.653     raeburn   535: </script>
                    536: ENDAUTHORBRW
                    537: }
                    538: 
1.91      www       539: sub coursebrowser_javascript {
1.1075.2.31  raeburn   540:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95  raeburn   541:         $credits_element,$instcode) = @_;
1.932     raeburn   542:     my $wintitle = 'Course_Browser';
1.931     raeburn   543:     if ($crstype eq 'Community') {
1.932     raeburn   544:         $wintitle = 'Community_Browser';
1.909     raeburn   545:     }
1.876     raeburn   546:     my $id_functions = &javascript_index_functions();
                    547:     my $output = '
1.776     bisitz    548: <script type="text/javascript" language="JavaScript">
1.824     bisitz    549: // <![CDATA[
1.468     raeburn   550:     var stdeditbrowser;'."\n";
1.876     raeburn   551: 
                    552:     $output .= <<"ENDSTDBRW";
1.909     raeburn   553:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       554:         var url = '/adm/pickcourse?';
1.895     raeburn   555:         var formid = getFormIdByName(formname);
1.876     raeburn   556:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  557:         if (domainfilter != null) {
                    558:            if (domainfilter != '') {
                    559:                url += 'domainfilter='+domainfilter+'&';
                    560: 	   }
                    561:         }
1.91      www       562:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  563: 	                            '&cdomelement='+udom+
                    564:                                     '&cnameelement='+desc;
1.468     raeburn   565:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   566:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   567:                 url += '&roleelement='+extra_element;
                    568:                 if (domainfilter == null || domainfilter == '') {
                    569:                     url += '&domainfilter='+extra_element;
                    570:                 }
1.234     raeburn   571:             }
1.468     raeburn   572:             else {
                    573:                 if (formname == 'portform') {
                    574:                     url += '&setroles='+extra_element;
1.800     raeburn   575:                 } else {
                    576:                     if (formname == 'rules') {
                    577:                         url += '&fixeddom='+extra_element; 
                    578:                     }
1.468     raeburn   579:                 }
                    580:             }     
1.230     raeburn   581:         }
1.909     raeburn   582:         if (type != null && type != '') {
                    583:             url += '&type='+type;
                    584:         }
                    585:         if (type_elem != null && type_elem != '') {
                    586:             url += '&typeelement='+type_elem;
                    587:         }
1.872     raeburn   588:         if (formname == 'ccrs') {
                    589:             var ownername = document.forms[formid].ccuname.value;
                    590:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101  raeburn   591:             url += '&cloner='+ownername+':'+ownerdom;
                    592:             if (type == 'Course') {
                    593:                 url += '&crscode='+document.forms[formid].crscode.value;
                    594:             }
1.1075.2.95  raeburn   595:         }
                    596:         if (formname == 'requestcrs') {
                    597:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   598:         }
1.293     raeburn   599:         if (multflag !=null && multflag != '') {
                    600:             url += '&multiple='+multflag;
                    601:         }
1.909     raeburn   602:         var title = '$wintitle';
1.91      www       603:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    604:         options += ',width=700,height=600';
                    605:         stdeditbrowser = open(url,title,options,'1');
                    606:         stdeditbrowser.focus();
                    607:     }
1.876     raeburn   608: $id_functions
                    609: ENDSTDBRW
1.1075.2.31  raeburn   610:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    611:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    612:                                       $credits_element);
1.876     raeburn   613:     }
                    614:     $output .= '
                    615: // ]]>
                    616: </script>';
                    617:     return $output;
                    618: }
                    619: 
                    620: sub javascript_index_functions {
                    621:     return <<"ENDJS";
                    622: 
                    623: function getFormIdByName(formname) {
                    624:     for (var i=0;i<document.forms.length;i++) {
                    625:         if (document.forms[i].name == formname) {
                    626:             return i;
                    627:         }
                    628:     }
                    629:     return -1;
                    630: }
                    631: 
                    632: function getIndexByName(formid,item) {
                    633:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    634:         if (document.forms[formid].elements[i].name == item) {
                    635:             return i;
                    636:         }
                    637:     }
                    638:     return -1;
                    639: }
1.468     raeburn   640: 
1.876     raeburn   641: function getDomainFromSelectbox(formname,udom) {
                    642:     var userdom;
                    643:     var formid = getFormIdByName(formname);
                    644:     if (formid > -1) {
                    645:         var domid = getIndexByName(formid,udom);
                    646:         if (domid > -1) {
                    647:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    648:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    649:             }
                    650:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    651:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   652:             }
                    653:         }
                    654:     }
1.876     raeburn   655:     return userdom;
                    656: }
                    657: 
                    658: ENDJS
1.468     raeburn   659: 
1.876     raeburn   660: }
                    661: 
1.1017    raeburn   662: sub javascript_array_indexof {
1.1018    raeburn   663:     return <<ENDJS;
1.1017    raeburn   664: <script type="text/javascript" language="JavaScript">
                    665: // <![CDATA[
                    666: 
                    667: if (!Array.prototype.indexOf) {
                    668:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    669:         "use strict";
                    670:         if (this === void 0 || this === null) {
                    671:             throw new TypeError();
                    672:         }
                    673:         var t = Object(this);
                    674:         var len = t.length >>> 0;
                    675:         if (len === 0) {
                    676:             return -1;
                    677:         }
                    678:         var n = 0;
                    679:         if (arguments.length > 0) {
                    680:             n = Number(arguments[1]);
                    681:             if (n !== n) { // shortcut for verifying if it's NaN
                    682:                 n = 0;
                    683:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    684:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    685:             }
                    686:         }
                    687:         if (n >= len) {
                    688:             return -1;
                    689:         }
                    690:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    691:         for (; k < len; k++) {
                    692:             if (k in t && t[k] === searchElement) {
                    693:                 return k;
                    694:             }
                    695:         }
                    696:         return -1;
                    697:     }
                    698: }
                    699: 
                    700: // ]]>
                    701: </script>
                    702: 
                    703: ENDJS
                    704: 
                    705: }
                    706: 
1.876     raeburn   707: sub userbrowser_javascript {
                    708:     my $id_functions = &javascript_index_functions();
                    709:     return <<"ENDUSERBRW";
                    710: 
1.888     raeburn   711: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   712:     var url = '/adm/pickuser?';
                    713:     var userdom = getDomainFromSelectbox(formname,udom);
                    714:     if (userdom != null) {
                    715:        if (userdom != '') {
                    716:            url += 'srchdom='+userdom+'&';
                    717:        }
                    718:     }
                    719:     url += 'form=' + formname + '&unameelement='+uname+
                    720:                                 '&udomelement='+udom+
                    721:                                 '&ulastelement='+ulast+
                    722:                                 '&ufirstelement='+ufirst+
                    723:                                 '&uemailelement='+uemail+
1.881     raeburn   724:                                 '&hideudomelement='+hideudom+
                    725:                                 '&coursedom='+crsdom;
1.888     raeburn   726:     if ((caller != null) && (caller != undefined)) {
                    727:         url += '&caller='+caller;
                    728:     }
1.876     raeburn   729:     var title = 'User_Browser';
                    730:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    731:     options += ',width=700,height=600';
                    732:     var stdeditbrowser = open(url,title,options,'1');
                    733:     stdeditbrowser.focus();
                    734: }
                    735: 
1.888     raeburn   736: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   737:     var formid = getFormIdByName(formname);
                    738:     if (formid > -1) {
1.888     raeburn   739:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   740:         var domid = getIndexByName(formid,udom);
                    741:         var hidedomid = getIndexByName(formid,origdom);
                    742:         if (hidedomid > -1) {
                    743:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   744:             var unameval = document.forms[formid].elements[unameid].value;
                    745:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    746:                 if (domid > -1) {
                    747:                     var slct = document.forms[formid].elements[domid];
                    748:                     if (slct.type == 'select-one') {
                    749:                         var i;
                    750:                         for (i=0;i<slct.length;i++) {
                    751:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    752:                         }
                    753:                     }
                    754:                     if (slct.type == 'hidden') {
                    755:                         slct.value = fixeddom;
1.876     raeburn   756:                     }
                    757:                 }
1.468     raeburn   758:             }
                    759:         }
                    760:     }
1.876     raeburn   761:     return;
                    762: }
                    763: 
                    764: $id_functions
                    765: ENDUSERBRW
1.468     raeburn   766: }
                    767: 
                    768: sub setsec_javascript {
1.1075.2.31  raeburn   769:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   770:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    771:         $communityrolestr);
                    772:     if ($role_element ne '') {
                    773:         my @allroles = ('st','ta','ep','in','ad');
                    774:         foreach my $crstype ('Course','Community') {
                    775:             if ($crstype eq 'Community') {
                    776:                 foreach my $role (@allroles) {
                    777:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    778:                 }
                    779:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    780:             } else {
                    781:                 foreach my $role (@allroles) {
                    782:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    783:                 }
                    784:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    785:             }
                    786:         }
                    787:         $rolestr = '"'.join('","',@allroles).'"';
                    788:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    789:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    790:     }
1.468     raeburn   791:     my $setsections = qq|
                    792: function setSect(sectionlist) {
1.629     raeburn   793:     var sectionsArray = new Array();
                    794:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    795:         sectionsArray = sectionlist.split(",");
                    796:     }
1.468     raeburn   797:     var numSections = sectionsArray.length;
                    798:     document.$formname.$sec_element.length = 0;
                    799:     if (numSections == 0) {
                    800:         document.$formname.$sec_element.multiple=false;
                    801:         document.$formname.$sec_element.size=1;
                    802:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    803:     } else {
                    804:         if (numSections == 1) {
                    805:             document.$formname.$sec_element.multiple=false;
                    806:             document.$formname.$sec_element.size=1;
                    807:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    808:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    809:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    810:         } else {
                    811:             for (var i=0; i<numSections; i++) {
                    812:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    813:             }
                    814:             document.$formname.$sec_element.multiple=true
                    815:             if (numSections < 3) {
                    816:                 document.$formname.$sec_element.size=numSections;
                    817:             } else {
                    818:                 document.$formname.$sec_element.size=3;
                    819:             }
                    820:             document.$formname.$sec_element.options[0].selected = false
                    821:         }
                    822:     }
1.91      www       823: }
1.905     raeburn   824: 
                    825: function setRole(crstype) {
1.468     raeburn   826: |;
1.905     raeburn   827:     if ($role_element eq '') {
                    828:         $setsections .= '    return;
                    829: }
                    830: ';
                    831:     } else {
                    832:         $setsections .= qq|
                    833:     var elementLength = document.$formname.$role_element.length;
                    834:     var allroles = Array($rolestr);
                    835:     var courserolenames = Array($courserolestr);
                    836:     var communityrolenames = Array($communityrolestr);
                    837:     if (elementLength != undefined) {
                    838:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    839:             if (crstype == 'Course') {
                    840:                 return;
                    841:             } else {
                    842:                 allroles[5] = 'co';
                    843:                 for (var i=0; i<6; i++) {
                    844:                     document.$formname.$role_element.options[i].value = allroles[i];
                    845:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    846:                 }
                    847:             }
                    848:         } else {
                    849:             if (crstype == 'Community') {
                    850:                 return;
                    851:             } else {
                    852:                 allroles[5] = 'cc';
                    853:                 for (var i=0; i<6; i++) {
                    854:                     document.$formname.$role_element.options[i].value = allroles[i];
                    855:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    856:                 }
                    857:             }
                    858:         }
                    859:     }
                    860:     return;
                    861: }
                    862: |;
                    863:     }
1.1075.2.31  raeburn   864:     if ($credits_element) {
                    865:         $setsections .= qq|
                    866: function setCredits(defaultcredits) {
                    867:     document.$formname.$credits_element.value = defaultcredits;
                    868:     return;
                    869: }
                    870: |;
                    871:     }
1.468     raeburn   872:     return $setsections;
                    873: }
                    874: 
1.91      www       875: sub selectcourse_link {
1.909     raeburn   876:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    877:        $typeelement) = @_;
                    878:    my $type = $selecttype;
1.871     raeburn   879:    my $linktext = &mt('Select Course');
                    880:    if ($selecttype eq 'Community') {
1.909     raeburn   881:        $linktext = &mt('Select Community');
1.906     raeburn   882:    } elsif ($selecttype eq 'Course/Community') {
                    883:        $linktext = &mt('Select Course/Community');
1.909     raeburn   884:        $type = '';
1.1019    raeburn   885:    } elsif ($selecttype eq 'Select') {
                    886:        $linktext = &mt('Select');
                    887:        $type = '';
1.871     raeburn   888:    }
1.787     bisitz    889:    return '<span class="LC_nobreak">'
                    890:          ."<a href='"
                    891:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    892:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   893:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   894:          ."'>".$linktext.'</a>'
1.787     bisitz    895:          .'</span>';
1.74      www       896: }
1.42      matthew   897: 
1.653     raeburn   898: sub selectauthor_link {
                    899:    my ($form,$udom)=@_;
                    900:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    901:           &mt('Select Author').'</a>';
                    902: }
                    903: 
1.876     raeburn   904: sub selectuser_link {
1.881     raeburn   905:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   906:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   907:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   908:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   909:            ');">'.$linktext.'</a>';
1.876     raeburn   910: }
                    911: 
1.273     raeburn   912: sub check_uncheck_jscript {
                    913:     my $jscript = <<"ENDSCRT";
                    914: function checkAll(field) {
                    915:     if (field.length > 0) {
                    916:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   917:             if (!field[i].disabled) {
                    918:                 field[i].checked = true;
                    919:             }
1.273     raeburn   920:         }
                    921:     } else {
1.1075.2.14  raeburn   922:         if (!field.disabled) {
                    923:             field.checked = true;
                    924:         }
1.273     raeburn   925:     }
                    926: }
                    927:  
                    928: function uncheckAll(field) {
                    929:     if (field.length > 0) {
                    930:         for (i = 0; i < field.length; i++) {
                    931:             field[i].checked = false ;
1.543     albertel  932:         }
                    933:     } else {
1.273     raeburn   934:         field.checked = false ;
                    935:     }
                    936: }
                    937: ENDSCRT
                    938:     return $jscript;
                    939: }
                    940: 
1.656     www       941: sub select_timezone {
1.1075.2.115  raeburn   942:    my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    943:    my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659     raeburn   944:    if ($includeempty) {
                    945:        $output .= '<option value=""';
                    946:        if (($selected eq '') || ($selected eq 'local')) {
                    947:            $output .= ' selected="selected" ';
                    948:        }
                    949:        $output .= '> </option>';
                    950:    }
1.657     raeburn   951:    my @timezones = DateTime::TimeZone->all_names;
                    952:    foreach my $tzone (@timezones) {
                    953:        $output.= '<option value="'.$tzone.'"';
                    954:        if ($tzone eq $selected) {
                    955:            $output.=' selected="selected"';
                    956:        }
                    957:        $output.=">$tzone</option>\n";
1.656     www       958:    }
                    959:    $output.="</select>";
                    960:    return $output;
                    961: }
1.273     raeburn   962: 
1.687     raeburn   963: sub select_datelocale {
1.1075.2.115  raeburn   964:     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    965:     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687     raeburn   966:     if ($includeempty) {
                    967:         $output .= '<option value=""';
                    968:         if ($selected eq '') {
                    969:             $output .= ' selected="selected" ';
                    970:         }
                    971:         $output .= '> </option>';
                    972:     }
1.1075.2.102  raeburn   973:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   974:     my (@possibles,%locale_names);
1.1075.2.102  raeburn   975:     my @locales = DateTime::Locale->ids();
                    976:     foreach my $id (@locales) {
                    977:         if ($id ne '') {
                    978:             my ($en_terr,$native_terr);
                    979:             my $loc = DateTime::Locale->load($id);
                    980:             if (ref($loc)) {
                    981:                 $en_terr = $loc->name();
                    982:                 $native_terr = $loc->native_name();
1.687     raeburn   983:                 if (grep(/^en$/,@languages) || !@languages) {
                    984:                     if ($en_terr ne '') {
                    985:                         $locale_names{$id} = '('.$en_terr.')';
                    986:                     } elsif ($native_terr ne '') {
                    987:                         $locale_names{$id} = $native_terr;
                    988:                     }
                    989:                 } else {
                    990:                     if ($native_terr ne '') {
                    991:                         $locale_names{$id} = $native_terr.' ';
                    992:                     } elsif ($en_terr ne '') {
                    993:                         $locale_names{$id} = '('.$en_terr.')';
                    994:                     }
                    995:                 }
1.1075.2.94  raeburn   996:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102  raeburn   997:                 push(@possibles,$id);
1.687     raeburn   998:             }
                    999:         }
                   1000:     }
                   1001:     foreach my $item (sort(@possibles)) {
                   1002:         $output.= '<option value="'.$item.'"';
                   1003:         if ($item eq $selected) {
                   1004:             $output.=' selected="selected"';
                   1005:         }
                   1006:         $output.=">$item";
                   1007:         if ($locale_names{$item} ne '') {
1.1075.2.94  raeburn  1008:             $output.='  '.$locale_names{$item};
1.687     raeburn  1009:         }
                   1010:         $output.="</option>\n";
                   1011:     }
                   1012:     $output.="</select>";
                   1013:     return $output;
                   1014: }
                   1015: 
1.792     raeburn  1016: sub select_language {
1.1075.2.115  raeburn  1017:     my ($name,$selected,$includeempty,$noedit) = @_;
1.792     raeburn  1018:     my %langchoices;
                   1019:     if ($includeempty) {
1.1075.2.32  raeburn  1020:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1021:     }
                   1022:     foreach my $id (&languageids()) {
                   1023:         my $code = &supportedlanguagecode($id);
                   1024:         if ($code) {
                   1025:             $langchoices{$code} = &plainlanguagedescription($id);
                   1026:         }
                   1027:     }
1.1075.2.32  raeburn  1028:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1075.2.115  raeburn  1029:     return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792     raeburn  1030: }
                   1031: 
1.42      matthew  1032: =pod
1.36      matthew  1033: 
1.648     raeburn  1034: =item * &linked_select_forms(...)
1.36      matthew  1035: 
                   1036: linked_select_forms returns a string containing a <script></script> block
                   1037: and html for two <select> menus.  The select menus will be linked in that
                   1038: changing the value of the first menu will result in new values being placed
                   1039: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1040: order unless a defined order is provided.
1.36      matthew  1041: 
                   1042: linked_select_forms takes the following ordered inputs:
                   1043: 
                   1044: =over 4
                   1045: 
1.112     bowersj2 1046: =item * $formname, the name of the <form> tag
1.36      matthew  1047: 
1.112     bowersj2 1048: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1049: 
1.112     bowersj2 1050: =item * $firstdefault, the default value for the first menu
1.36      matthew  1051: 
1.112     bowersj2 1052: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1053: 
1.112     bowersj2 1054: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1055: 
1.112     bowersj2 1056: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1057: 
1.609     raeburn  1058: =item * $menuorder, the order of values in the first menu
                   1059: 
1.1075.2.31  raeburn  1060: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1061:         event for the first <select> tag
                   1062: 
                   1063: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1064:         event for the second <select> tag
                   1065: 
1.41      ng       1066: =back 
                   1067: 
1.36      matthew  1068: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1069: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1070: values for the first select menu.  The text that coincides with the 
1.41      ng       1071: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1072: and text for the second menu are given in the hash pointed to by 
                   1073: $menu{$choice1}->{'select2'}.  
                   1074: 
1.112     bowersj2 1075:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1076:                        default => "B3",
                   1077:                        select2 => { 
                   1078:                            B1 => "Choice B1",
                   1079:                            B2 => "Choice B2",
                   1080:                            B3 => "Choice B3",
                   1081:                            B4 => "Choice B4"
1.609     raeburn  1082:                            },
                   1083:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1084:                    },
                   1085:                A2 => { text =>"Choice A2" ,
                   1086:                        default => "C2",
                   1087:                        select2 => { 
                   1088:                            C1 => "Choice C1",
                   1089:                            C2 => "Choice C2",
                   1090:                            C3 => "Choice C3"
1.609     raeburn  1091:                            },
                   1092:                        order => ['C2','C1','C3'],
1.112     bowersj2 1093:                    },
                   1094:                A3 => { text =>"Choice A3" ,
                   1095:                        default => "D6",
                   1096:                        select2 => { 
                   1097:                            D1 => "Choice D1",
                   1098:                            D2 => "Choice D2",
                   1099:                            D3 => "Choice D3",
                   1100:                            D4 => "Choice D4",
                   1101:                            D5 => "Choice D5",
                   1102:                            D6 => "Choice D6",
                   1103:                            D7 => "Choice D7"
1.609     raeburn  1104:                            },
                   1105:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1106:                    }
                   1107:                );
1.36      matthew  1108: 
                   1109: =cut
                   1110: 
                   1111: sub linked_select_forms {
                   1112:     my ($formname,
                   1113:         $middletext,
                   1114:         $firstdefault,
                   1115:         $firstselectname,
                   1116:         $secondselectname, 
1.609     raeburn  1117:         $hashref,
                   1118:         $menuorder,
1.1075.2.31  raeburn  1119:         $onchangefirst,
                   1120:         $onchangesecond
1.36      matthew  1121:         ) = @_;
                   1122:     my $second = "document.$formname.$secondselectname";
                   1123:     my $first = "document.$formname.$firstselectname";
                   1124:     # output the javascript to do the changing
                   1125:     my $result = '';
1.776     bisitz   1126:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1127:     $result.="// <![CDATA[\n";
1.36      matthew  1128:     $result.="var select2data = new Object();\n";
                   1129:     $" = '","';
                   1130:     my $debug = '';
                   1131:     foreach my $s1 (sort(keys(%$hashref))) {
                   1132:         $result.="select2data.d_$s1 = new Object();\n";        
                   1133:         $result.="select2data.d_$s1.def = new String('".
                   1134:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1135:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1136:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1137:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1138:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1139:         }
1.36      matthew  1140:         $result.="\"@s2values\");\n";
                   1141:         $result.="select2data.d_$s1.texts = new Array(";        
                   1142:         my @s2texts;
                   1143:         foreach my $value (@s2values) {
1.1075.2.119  raeburn  1144:             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36      matthew  1145:         }
                   1146:         $result.="\"@s2texts\");\n";
                   1147:     }
                   1148:     $"=' ';
                   1149:     $result.= <<"END";
                   1150: 
                   1151: function select1_changed() {
                   1152:     // Determine new choice
                   1153:     var newvalue = "d_" + $first.value;
                   1154:     // update select2
                   1155:     var values     = select2data[newvalue].values;
                   1156:     var texts      = select2data[newvalue].texts;
                   1157:     var select2def = select2data[newvalue].def;
                   1158:     var i;
                   1159:     // out with the old
                   1160:     for (i = 0; i < $second.options.length; i++) {
                   1161:         $second.options[i] = null;
                   1162:     }
                   1163:     // in with the nuclear
                   1164:     for (i=0;i<values.length; i++) {
                   1165:         $second.options[i] = new Option(values[i]);
1.143     matthew  1166:         $second.options[i].value = values[i];
1.36      matthew  1167:         $second.options[i].text = texts[i];
                   1168:         if (values[i] == select2def) {
                   1169:             $second.options[i].selected = true;
                   1170:         }
                   1171:     }
                   1172: }
1.824     bisitz   1173: // ]]>
1.36      matthew  1174: </script>
                   1175: END
                   1176:     # output the initial values for the selection lists
1.1075.2.31  raeburn  1177:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1178:     my @order = sort(keys(%{$hashref}));
                   1179:     if (ref($menuorder) eq 'ARRAY') {
                   1180:         @order = @{$menuorder};
                   1181:     }
                   1182:     foreach my $value (@order) {
1.36      matthew  1183:         $result.="    <option value=\"$value\" ";
1.253     albertel 1184:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1185:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1186:     }
                   1187:     $result .= "</select>\n";
                   1188:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1189:     $result .= $middletext;
1.1075.2.31  raeburn  1190:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1191:     if ($onchangesecond) {
                   1192:         $result .= ' onchange="'.$onchangesecond.'"';
                   1193:     }
                   1194:     $result .= ">\n";
1.36      matthew  1195:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1196:     
                   1197:     my @secondorder = sort(keys(%select2));
                   1198:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1199:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1200:     }
                   1201:     foreach my $value (@secondorder) {
1.36      matthew  1202:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1203:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1204:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1205:     }
                   1206:     $result .= "</select>\n";
                   1207:     #    return $debug;
                   1208:     return $result;
                   1209: }   #  end of sub linked_select_forms {
                   1210: 
1.45      matthew  1211: =pod
1.44      bowersj2 1212: 
1.973     raeburn  1213: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1214: 
1.112     bowersj2 1215: Returns a string corresponding to an HTML link to the given help
                   1216: $topic, where $topic corresponds to the name of a .tex file in
                   1217: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1218: spaces. 
                   1219: 
                   1220: $text will optionally be linked to the same topic, allowing you to
                   1221: link text in addition to the graphic. If you do not want to link
                   1222: text, but wish to specify one of the later parameters, pass an
                   1223: empty string. 
                   1224: 
                   1225: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1226: the link will not open a new window. If false, the link will open
                   1227: a new window using Javascript. (Default is false.) 
                   1228: 
                   1229: $width and $height are optional numerical parameters that will
                   1230: override the width and height of the popped up window, which may
1.973     raeburn  1231: be useful for certain help topics with big pictures included.
                   1232: 
                   1233: $imgid is the id of the img tag used for the help icon. This may be
                   1234: used in a javascript call to switch the image src.  See 
                   1235: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1236: 
                   1237: =cut
                   1238: 
                   1239: sub help_open_topic {
1.973     raeburn  1240:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1241:     $text = "" if (not defined $text);
1.44      bowersj2 1242:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1243:     $width = 500 if (not defined $width);
1.44      bowersj2 1244:     $height = 400 if (not defined $height);
                   1245:     my $filename = $topic;
                   1246:     $filename =~ s/ /_/g;
                   1247: 
1.48      bowersj2 1248:     my $template = "";
                   1249:     my $link;
1.572     banghart 1250:     
1.159     www      1251:     $topic=~s/\W/\_/g;
1.44      bowersj2 1252: 
1.572     banghart 1253:     if (!$stayOnPage) {
1.1075.2.50  raeburn  1254:         if ($env{'browser.mobile'}) {
                   1255: 	    $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
                   1256:         } else {
                   1257:             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1258:         }
1.1037    www      1259:     } elsif ($stayOnPage eq 'popup') {
                   1260:         $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 1261:     } else {
1.48      bowersj2 1262: 	$link = "/adm/help/${filename}.hlp";
                   1263:     }
                   1264: 
                   1265:     # Add the text
1.755     neumanie 1266:     if ($text ne "") {	
1.763     bisitz   1267: 	$template.='<span class="LC_help_open_topic">'
                   1268:                   .'<a target="_top" href="'.$link.'">'
                   1269:                   .$text.'</a>';
1.48      bowersj2 1270:     }
                   1271: 
1.763     bisitz   1272:     # (Always) Add the graphic
1.179     matthew  1273:     my $title = &mt('Online Help');
1.667     raeburn  1274:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1275:     if ($imgid ne '') {
                   1276:         $imgid = ' id="'.$imgid.'"';
                   1277:     }
1.763     bisitz   1278:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1279:               .'<img src="'.$helpicon.'" border="0"'
                   1280:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1281:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1282:               .' /></a>';
                   1283:     if ($text ne "") {	
                   1284:         $template.='</span>';
                   1285:     }
1.44      bowersj2 1286:     return $template;
                   1287: 
1.106     bowersj2 1288: }
                   1289: 
                   1290: # This is a quicky function for Latex cheatsheet editing, since it 
                   1291: # appears in at least four places
                   1292: sub helpLatexCheatsheet {
1.1037    www      1293:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1294:     my $out;
1.106     bowersj2 1295:     my $addOther = '';
1.732     raeburn  1296:     if ($topic) {
1.1037    www      1297: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1298:     }
                   1299:     $out = '<span>' # Start cheatsheet
                   1300: 	  .$addOther
                   1301:           .'<span>'
1.1037    www      1302: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1303: 	  .'</span> <span>'
1.1037    www      1304: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1305: 	  .'</span>';
1.732     raeburn  1306:     unless ($not_author) {
1.763     bisitz   1307:         $out .= ' <span>'
1.1037    www      1308: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1309: 	       .'</span> <span>'
1.1075.2.78  raeburn  1310:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1311:                .'</span>';
1.732     raeburn  1312:     }
1.763     bisitz   1313:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1314:     return $out;
1.172     www      1315: }
                   1316: 
1.430     albertel 1317: sub general_help {
                   1318:     my $helptopic='Student_Intro';
                   1319:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1320: 	$helptopic='Authoring_Intro';
1.907     raeburn  1321:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1322: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1323:     } elsif ($env{'request.role'}=~/^dc/) {
                   1324:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1325:     }
                   1326:     return $helptopic;
                   1327: }
                   1328: 
                   1329: sub update_help_link {
                   1330:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1331:     my $origurl = $ENV{'REQUEST_URI'};
                   1332:     $origurl=~s|^/~|/priv/|;
                   1333:     my $timestamp = time;
                   1334:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1335:         $$datum = &escape($$datum);
                   1336:     }
                   1337: 
                   1338:     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";
                   1339:     my $output .= <<"ENDOUTPUT";
                   1340: <script type="text/javascript">
1.824     bisitz   1341: // <![CDATA[
1.430     albertel 1342: banner_link = '$banner_link';
1.824     bisitz   1343: // ]]>
1.430     albertel 1344: </script>
                   1345: ENDOUTPUT
                   1346:     return $output;
                   1347: }
                   1348: 
                   1349: # now just updates the help link and generates a blue icon
1.193     raeburn  1350: sub help_open_menu {
1.430     albertel 1351:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1352: 	= @_;    
1.949     droeschl 1353:     $stayOnPage = 1;
1.430     albertel 1354:     my $output;
                   1355:     if ($component_help) {
                   1356: 	if (!$text) {
                   1357: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1358: 				       $width,$height);
                   1359: 	} else {
                   1360: 	    my $help_text;
                   1361: 	    $help_text=&unescape($topic);
                   1362: 	    $output='<table><tr><td>'.
                   1363: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1364: 				 $width,$height).'</td></tr></table>';
                   1365: 	}
                   1366:     }
                   1367:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1368:     return $output.$banner_link;
                   1369: }
                   1370: 
                   1371: sub top_nav_help {
                   1372:     my ($text) = @_;
1.436     albertel 1373:     $text = &mt($text);
1.1075.2.60  raeburn  1374:     my $stay_on_page;
                   1375:     unless ($env{'environment.remote'} eq 'on') {
                   1376:         $stay_on_page = 1;
                   1377:     }
1.1075.2.61  raeburn  1378:     my ($link,$banner_link);
                   1379:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1380:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1381: 	                         : "javascript:helpMenu('open')";
                   1382:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1383:     }
1.201     raeburn  1384:     my $title = &mt('Get help');
1.1075.2.61  raeburn  1385:     if ($link) {
                   1386:         return <<"END";
1.436     albertel 1387: $banner_link
1.1075.2.56  raeburn  1388: <a href="$link" title="$title">$text</a>
1.436     albertel 1389: END
1.1075.2.61  raeburn  1390:     } else {
                   1391:         return '&nbsp;'.$text.'&nbsp;';
                   1392:     }
1.436     albertel 1393: }
                   1394: 
                   1395: sub help_menu_js {
1.1075.2.52  raeburn  1396:     my ($httphost) = @_;
1.949     droeschl 1397:     my $stayOnPage = 1;
1.436     albertel 1398:     my $width = 620;
                   1399:     my $height = 600;
1.430     albertel 1400:     my $helptopic=&general_help();
1.1075.2.52  raeburn  1401:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1402:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1403:     my $start_page =
                   1404:         &Apache::loncommon::start_page('Help Menu', undef,
                   1405: 				       {'frameset'    => 1,
                   1406: 					'js_ready'    => 1,
1.1075.2.136  raeburn  1407:                                         'use_absolute' => $httphost,
1.331     albertel 1408: 					'add_entries' => {
                   1409: 					    'border' => '0',
1.579     raeburn  1410: 					    'rows'   => "110,*",},});
1.331     albertel 1411:     my $end_page =
                   1412:         &Apache::loncommon::end_page({'frameset' => 1,
                   1413: 				      'js_ready' => 1,});
                   1414: 
1.436     albertel 1415:     my $template .= <<"ENDTEMPLATE";
                   1416: <script type="text/javascript">
1.877     bisitz   1417: // <![CDATA[
1.253     albertel 1418: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1419: var banner_link = '';
1.243     raeburn  1420: function helpMenu(target) {
                   1421:     var caller = this;
                   1422:     if (target == 'open') {
                   1423:         var newWindow = null;
                   1424:         try {
1.262     albertel 1425:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1426:         }
                   1427:         catch(error) {
                   1428:             writeHelp(caller);
                   1429:             return;
                   1430:         }
                   1431:         if (newWindow) {
                   1432:             caller = newWindow;
                   1433:         }
1.193     raeburn  1434:     }
1.243     raeburn  1435:     writeHelp(caller);
                   1436:     return;
                   1437: }
                   1438: function writeHelp(caller) {
1.1075.2.61  raeburn  1439:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1440:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1441:     caller.document.close();
                   1442:     caller.focus();
1.193     raeburn  1443: }
1.877     bisitz   1444: // END LON-CAPA Internal -->
1.253     albertel 1445: // ]]>
1.436     albertel 1446: </script>
1.193     raeburn  1447: ENDTEMPLATE
                   1448:     return $template;
                   1449: }
                   1450: 
1.172     www      1451: sub help_open_bug {
                   1452:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1453:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1454:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1455:     $text = "" if (not defined $text);
                   1456: 	$stayOnPage=1;
1.184     albertel 1457:     $width = 600 if (not defined $width);
                   1458:     $height = 600 if (not defined $height);
1.172     www      1459: 
                   1460:     $topic=~s/\W+/\+/g;
                   1461:     my $link='';
                   1462:     my $template='';
1.379     albertel 1463:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1464: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1465:     if (!$stayOnPage)
                   1466:     {
                   1467: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1468:     }
                   1469:     else
                   1470:     {
                   1471: 	$link = $url;
                   1472:     }
                   1473:     # Add the text
                   1474:     if ($text ne "")
                   1475:     {
                   1476: 	$template .= 
                   1477:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1478:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1479:     }
                   1480: 
                   1481:     # Add the graphic
1.179     matthew  1482:     my $title = &mt('Report a Bug');
1.215     albertel 1483:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1484:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1485:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1486: ENDTEMPLATE
                   1487:     if ($text ne '') { $template.='</td></tr></table>' };
                   1488:     return $template;
                   1489: 
                   1490: }
                   1491: 
                   1492: sub help_open_faq {
                   1493:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1494:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1495:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1496:     $text = "" if (not defined $text);
                   1497: 	$stayOnPage=1;
                   1498:     $width = 350 if (not defined $width);
                   1499:     $height = 400 if (not defined $height);
                   1500: 
                   1501:     $topic=~s/\W+/\+/g;
                   1502:     my $link='';
                   1503:     my $template='';
                   1504:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1505:     if (!$stayOnPage)
                   1506:     {
                   1507: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1508:     }
                   1509:     else
                   1510:     {
                   1511: 	$link = $url;
                   1512:     }
                   1513: 
                   1514:     # Add the text
                   1515:     if ($text ne "")
                   1516:     {
                   1517: 	$template .= 
1.173     www      1518:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1519:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1520:     }
                   1521: 
                   1522:     # Add the graphic
1.179     matthew  1523:     my $title = &mt('View the FAQ');
1.215     albertel 1524:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1525:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1526:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1527: ENDTEMPLATE
                   1528:     if ($text ne '') { $template.='</td></tr></table>' };
                   1529:     return $template;
                   1530: 
1.44      bowersj2 1531: }
1.37      matthew  1532: 
1.180     matthew  1533: ###############################################################
                   1534: ###############################################################
                   1535: 
1.45      matthew  1536: =pod
                   1537: 
1.648     raeburn  1538: =item * &change_content_javascript():
1.256     matthew  1539: 
                   1540: This and the next function allow you to create small sections of an
                   1541: otherwise static HTML page that you can update on the fly with
                   1542: Javascript, even in Netscape 4.
                   1543: 
                   1544: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1545: must be written to the HTML page once. It will prove the Javascript
                   1546: function "change(name, content)". Calling the change function with the
                   1547: name of the section 
                   1548: you want to update, matching the name passed to C<changable_area>, and
                   1549: the new content you want to put in there, will put the content into
                   1550: that area.
                   1551: 
                   1552: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1553: to contain room for the original contents. You need to "make space"
                   1554: for whatever changes you wish to make, and be B<sure> to check your
                   1555: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1556: it's adequate for updating a one-line status display, but little more.
                   1557: This script will set the space to 100% width, so you only need to
                   1558: worry about height in Netscape 4.
                   1559: 
                   1560: Modern browsers are much less limiting, and if you can commit to the
                   1561: user not using Netscape 4, this feature may be used freely with
                   1562: pretty much any HTML.
                   1563: 
                   1564: =cut
                   1565: 
                   1566: sub change_content_javascript {
                   1567:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1568:     if ($env{'browser.type'} eq 'netscape' &&
                   1569: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1570: 	return (<<NETSCAPE4);
                   1571: 	function change(name, content) {
                   1572: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1573: 	    doc.open();
                   1574: 	    doc.write(content);
                   1575: 	    doc.close();
                   1576: 	}
                   1577: NETSCAPE4
                   1578:     } else {
                   1579: 	# Otherwise, we need to use semi-standards-compliant code
                   1580: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1581: 	# is really scary, and every useful browser supports it
                   1582: 	return (<<DOMBASED);
                   1583: 	function change(name, content) {
                   1584: 	    element = document.getElementById(name);
                   1585: 	    element.innerHTML = content;
                   1586: 	}
                   1587: DOMBASED
                   1588:     }
                   1589: }
                   1590: 
                   1591: =pod
                   1592: 
1.648     raeburn  1593: =item * &changable_area($name,$origContent):
1.256     matthew  1594: 
                   1595: This provides a "changable area" that can be modified on the fly via
                   1596: the Javascript code provided in C<change_content_javascript>. $name is
                   1597: the name you will use to reference the area later; do not repeat the
                   1598: same name on a given HTML page more then once. $origContent is what
                   1599: the area will originally contain, which can be left blank.
                   1600: 
                   1601: =cut
                   1602: 
                   1603: sub changable_area {
                   1604:     my ($name, $origContent) = @_;
                   1605: 
1.258     albertel 1606:     if ($env{'browser.type'} eq 'netscape' &&
                   1607: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1608: 	# If this is netscape 4, we need to use the Layer tag
                   1609: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1610:     } else {
                   1611: 	return "<span id='$name'>$origContent</span>";
                   1612:     }
                   1613: }
                   1614: 
                   1615: =pod
                   1616: 
1.648     raeburn  1617: =item * &viewport_geometry_js 
1.590     raeburn  1618: 
                   1619: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1620: 
                   1621: =cut
                   1622: 
                   1623: 
                   1624: sub viewport_geometry_js { 
                   1625:     return <<"GEOMETRY";
                   1626: var Geometry = {};
                   1627: function init_geometry() {
                   1628:     if (Geometry.init) { return };
                   1629:     Geometry.init=1;
                   1630:     if (window.innerHeight) {
                   1631:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1632:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1633:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1634:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1635:     }
                   1636:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1637:         Geometry.getViewportHeight =
                   1638:             function() { return document.documentElement.clientHeight; };
                   1639:         Geometry.getViewportWidth =
                   1640:             function() { return document.documentElement.clientWidth; };
                   1641: 
                   1642:         Geometry.getHorizontalScroll =
                   1643:             function() { return document.documentElement.scrollLeft; };
                   1644:         Geometry.getVerticalScroll =
                   1645:             function() { return document.documentElement.scrollTop; };
                   1646:     }
                   1647:     else if (document.body.clientHeight) {
                   1648:         Geometry.getViewportHeight =
                   1649:             function() { return document.body.clientHeight; };
                   1650:         Geometry.getViewportWidth =
                   1651:             function() { return document.body.clientWidth; };
                   1652:         Geometry.getHorizontalScroll =
                   1653:             function() { return document.body.scrollLeft; };
                   1654:         Geometry.getVerticalScroll =
                   1655:             function() { return document.body.scrollTop; };
                   1656:     }
                   1657: }
                   1658: 
                   1659: GEOMETRY
                   1660: }
                   1661: 
                   1662: =pod
                   1663: 
1.648     raeburn  1664: =item * &viewport_size_js()
1.590     raeburn  1665: 
                   1666: 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. 
                   1667: 
                   1668: =cut
                   1669: 
                   1670: sub viewport_size_js {
                   1671:     my $geometry = &viewport_geometry_js();
                   1672:     return <<"DIMS";
                   1673: 
                   1674: $geometry
                   1675: 
                   1676: function getViewportDims(width,height) {
                   1677:     init_geometry();
                   1678:     width.value = Geometry.getViewportWidth();
                   1679:     height.value = Geometry.getViewportHeight();
                   1680:     return;
                   1681: }
                   1682: 
                   1683: DIMS
                   1684: }
                   1685: 
                   1686: =pod
                   1687: 
1.648     raeburn  1688: =item * &resize_textarea_js()
1.565     albertel 1689: 
                   1690: emits the needed javascript to resize a textarea to be as big as possible
                   1691: 
                   1692: creates a function resize_textrea that takes two IDs first should be
                   1693: the id of the element to resize, second should be the id of a div that
                   1694: surrounds everything that comes after the textarea, this routine needs
                   1695: to be attached to the <body> for the onload and onresize events.
                   1696: 
1.648     raeburn  1697: =back
1.565     albertel 1698: 
                   1699: =cut
                   1700: 
                   1701: sub resize_textarea_js {
1.590     raeburn  1702:     my $geometry = &viewport_geometry_js();
1.565     albertel 1703:     return <<"RESIZE";
                   1704:     <script type="text/javascript">
1.824     bisitz   1705: // <![CDATA[
1.590     raeburn  1706: $geometry
1.565     albertel 1707: 
1.588     albertel 1708: function getX(element) {
                   1709:     var x = 0;
                   1710:     while (element) {
                   1711: 	x += element.offsetLeft;
                   1712: 	element = element.offsetParent;
                   1713:     }
                   1714:     return x;
                   1715: }
                   1716: function getY(element) {
                   1717:     var y = 0;
                   1718:     while (element) {
                   1719: 	y += element.offsetTop;
                   1720: 	element = element.offsetParent;
                   1721:     }
                   1722:     return y;
                   1723: }
                   1724: 
                   1725: 
1.565     albertel 1726: function resize_textarea(textarea_id,bottom_id) {
                   1727:     init_geometry();
                   1728:     var textarea        = document.getElementById(textarea_id);
                   1729:     //alert(textarea);
                   1730: 
1.588     albertel 1731:     var textarea_top    = getY(textarea);
1.565     albertel 1732:     var textarea_height = textarea.offsetHeight;
                   1733:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1734:     var bottom_top      = getY(bottom);
1.565     albertel 1735:     var bottom_height   = bottom.offsetHeight;
                   1736:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1737:     var fudge           = 23;
1.565     albertel 1738:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1739:     if (new_height < 300) {
                   1740: 	new_height = 300;
                   1741:     }
                   1742:     textarea.style.height=new_height+'px';
                   1743: }
1.824     bisitz   1744: // ]]>
1.565     albertel 1745: </script>
                   1746: RESIZE
                   1747: 
                   1748: }
                   1749: 
1.1075.2.112  raeburn  1750: sub colorfuleditor_js {
                   1751:     return <<"COLORFULEDIT"
                   1752: <script type="text/javascript">
                   1753: // <![CDATA[>
                   1754:     function fold_box(curDepth, lastresource){
                   1755: 
                   1756:     // we need a list because there can be several blocks you need to fold in one tag
                   1757:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1758:     // but there is only one folding button per tag
                   1759:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1760: 
                   1761:         if(block.item(0).style.display == 'none'){
                   1762: 
                   1763:             foldbutton.value = '@{[&mt("Hide")]}';
                   1764:             for (i = 0; i < block.length; i++){
                   1765:                 block.item(i).style.display = '';
                   1766:             }
                   1767:         }else{
                   1768: 
                   1769:             foldbutton.value = '@{[&mt("Show")]}';
                   1770:             for (i = 0; i < block.length; i++){
                   1771:                 // block.item(i).style.visibility = 'collapse';
                   1772:                 block.item(i).style.display = 'none';
                   1773:             }
                   1774:         };
                   1775:         saveState(lastresource);
                   1776:     }
                   1777: 
                   1778:     function saveState (lastresource) {
                   1779: 
                   1780:         var tag_list = getTagList();
                   1781:         if(tag_list != null){
                   1782:             var timestamp = new Date().getTime();
                   1783:             var key = lastresource;
                   1784: 
                   1785:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1786:             // starting with timestamp
                   1787:             var value = timestamp+';';
                   1788: 
                   1789:             // building the list of key-value pairs
                   1790:             for(var i = 0; i < tag_list.length; i++){
                   1791:                 value += tag_list[i]+',';
                   1792:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1793:             }
                   1794: 
                   1795:             // only iterate whole storage if nothing to override
                   1796:             if(localStorage.getItem(key) == null){
                   1797: 
                   1798:                 // prevent storage from growing large
                   1799:                 if(localStorage.length > 50){
                   1800:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1801:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1802:                     var oldest_key;
                   1803: 
                   1804:                     for(var i = 1; i < localStorage.length; i++){
                   1805:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1806:                             oldest_key = localStorage.key(i);
                   1807:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1808:                         }
                   1809:                     }
                   1810:                     localStorage.removeItem(oldest_key);
                   1811:                 }
                   1812:             }
                   1813:             localStorage.setItem(key,value);
                   1814:         }
                   1815:     }
                   1816: 
                   1817:     // restore folding status of blocks (on page load)
                   1818:     function restoreState (lastresource) {
                   1819:         if(localStorage.getItem(lastresource) != null){
                   1820:             var key = lastresource;
                   1821:             var value = localStorage.getItem(key);
                   1822:             var regex_delTimestamp = /^\d+;/;
                   1823: 
                   1824:             value.replace(regex_delTimestamp, '');
                   1825: 
                   1826:             var valueArr = value.split(';');
                   1827:             var pairs;
                   1828:             var elements;
                   1829:             for (var i = 0; i < valueArr.length; i++){
                   1830:                 pairs = valueArr[i].split(',');
                   1831:                 elements = document.getElementsByName(pairs[0]);
                   1832: 
                   1833:                 for (var j = 0; j < elements.length; j++){
                   1834:                     elements[j].style.display = pairs[1];
                   1835:                     if (pairs[1] == "none"){
                   1836:                         var regex_id = /([_\\d]+)\$/;
                   1837:                         regex_id.exec(pairs[0]);
                   1838:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   1839:                     }
                   1840:                 }
                   1841:             }
                   1842:         }
                   1843:     }
                   1844: 
                   1845:     function getTagList () {
                   1846: 
                   1847:         var stringToSearch = document.lonhomework.innerHTML;
                   1848: 
                   1849:         var ret = new Array();
                   1850:         var regex_findBlock = /(foldblock_.*?)"/g;
                   1851:         var tag_list = stringToSearch.match(regex_findBlock);
                   1852: 
                   1853:         if(tag_list != null){
                   1854:             for(var i = 0; i < tag_list.length; i++){
                   1855:                 ret.push(tag_list[i].replace(/"/, ''));
                   1856:             }
                   1857:         }
                   1858:         return ret;
                   1859:     }
                   1860: 
                   1861:     function saveScrollPosition (resource) {
                   1862:         var tag_list = getTagList();
                   1863: 
                   1864:         // we dont always want to jump to the first block
                   1865:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   1866:         if(\$(window).scrollTop() > 170){
                   1867:             if(tag_list != null){
                   1868:                 var result;
                   1869:                 for(var i = 0; i < tag_list.length; i++){
                   1870:                     if(isElementInViewport(tag_list[i])){
                   1871:                         result += tag_list[i]+';';
                   1872:                     }
                   1873:                 }
                   1874:                 sessionStorage.setItem('anchor_'+resource, result);
                   1875:             }
                   1876:         } else {
                   1877:             // we dont need to save zero, just delete the item to leave everything tidy
                   1878:             sessionStorage.removeItem('anchor_'+resource);
                   1879:         }
                   1880:     }
                   1881: 
                   1882:     function restoreScrollPosition(resource){
                   1883: 
                   1884:         var elem = sessionStorage.getItem('anchor_'+resource);
                   1885:         if(elem != null){
                   1886:             var tag_list = elem.split(';');
                   1887:             var elem_list;
                   1888: 
                   1889:             for(var i = 0; i < tag_list.length; i++){
                   1890:                 elem_list = document.getElementsByName(tag_list[i]);
                   1891: 
                   1892:                 if(elem_list.length > 0){
                   1893:                     elem = elem_list[0];
                   1894:                     break;
                   1895:                 }
                   1896:             }
                   1897:             elem.scrollIntoView();
                   1898:         }
                   1899:     }
                   1900: 
                   1901:     function isElementInViewport(el) {
                   1902: 
                   1903:         // change to last element instead of first
                   1904:         var elem = document.getElementsByName(el);
                   1905:         var rect = elem[0].getBoundingClientRect();
                   1906: 
                   1907:         return (
                   1908:             rect.top >= 0 &&
                   1909:             rect.left >= 0 &&
                   1910:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   1911:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   1912:         );
                   1913:     }
                   1914: 
                   1915:     function autosize(depth){
                   1916:         var cmInst = window['cm'+depth];
                   1917:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   1918: 
                   1919:         // is fixed size, switching to dynamic
                   1920:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   1921:             cmInst.setSize("","auto");
                   1922:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   1923:             sessionStorage.setItem("autosized_"+depth, "yes");
                   1924: 
                   1925:         // is dynamic size, switching to fixed
                   1926:         } else {
                   1927:             cmInst.setSize("","300px");
                   1928:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   1929:             sessionStorage.removeItem("autosized_"+depth);
                   1930:         }
                   1931:     }
                   1932: 
                   1933: 
                   1934: 
                   1935: // ]]>
                   1936: </script>
                   1937: COLORFULEDIT
                   1938: }
                   1939: 
                   1940: sub xmleditor_js {
                   1941:     return <<XMLEDIT
                   1942: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   1943: <script type="text/javascript">
                   1944: // <![CDATA[>
                   1945: 
                   1946:     function saveScrollPosition (resource) {
                   1947: 
                   1948:         var scrollPos = \$(window).scrollTop();
                   1949:         sessionStorage.setItem(resource,scrollPos);
                   1950:     }
                   1951: 
                   1952:     function restoreScrollPosition(resource){
                   1953: 
                   1954:         var scrollPos = sessionStorage.getItem(resource);
                   1955:         \$(window).scrollTop(scrollPos);
                   1956:     }
                   1957: 
                   1958:     // unless internet explorer
                   1959:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   1960: 
                   1961:         \$(document).ready(function() {
                   1962:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   1963:         });
                   1964:     }
                   1965: 
                   1966:     // inserts text at cursor position into codemirror (xml editor only)
                   1967:     function insertText(text){
                   1968:         cm.focus();
                   1969:         var curPos = cm.getCursor();
                   1970:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   1971:     }
                   1972: // ]]>
                   1973: </script>
                   1974: XMLEDIT
                   1975: }
                   1976: 
                   1977: sub insert_folding_button {
                   1978:     my $curDepth = $Apache::lonxml::curdepth;
                   1979:     my $lastresource = $env{'request.ambiguous'};
                   1980: 
                   1981:     return "<input type=\"button\" id=\"folding_btn_$curDepth\"
                   1982:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   1983: }
                   1984: 
                   1985: 
1.565     albertel 1986: =pod
                   1987: 
1.256     matthew  1988: =head1 Excel and CSV file utility routines
                   1989: 
                   1990: =cut
                   1991: 
                   1992: ###############################################################
                   1993: ###############################################################
                   1994: 
                   1995: =pod
                   1996: 
1.1075.2.56  raeburn  1997: =over 4
                   1998: 
1.648     raeburn  1999: =item * &csv_translate($text) 
1.37      matthew  2000: 
1.185     www      2001: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2002: format.
                   2003: 
                   2004: =cut
                   2005: 
1.180     matthew  2006: ###############################################################
                   2007: ###############################################################
1.37      matthew  2008: sub csv_translate {
                   2009:     my $text = shift;
                   2010:     $text =~ s/\"/\"\"/g;
1.209     albertel 2011:     $text =~ s/\n/ /g;
1.37      matthew  2012:     return $text;
                   2013: }
1.180     matthew  2014: 
                   2015: ###############################################################
                   2016: ###############################################################
                   2017: 
                   2018: =pod
                   2019: 
1.648     raeburn  2020: =item * &define_excel_formats()
1.180     matthew  2021: 
                   2022: Define some commonly used Excel cell formats.
                   2023: 
                   2024: Currently supported formats:
                   2025: 
                   2026: =over 4
                   2027: 
                   2028: =item header
                   2029: 
                   2030: =item bold
                   2031: 
                   2032: =item h1
                   2033: 
                   2034: =item h2
                   2035: 
                   2036: =item h3
                   2037: 
1.256     matthew  2038: =item h4
                   2039: 
                   2040: =item i
                   2041: 
1.180     matthew  2042: =item date
                   2043: 
                   2044: =back
                   2045: 
                   2046: Inputs: $workbook
                   2047: 
                   2048: Returns: $format, a hash reference.
                   2049: 
1.1057    foxr     2050: 
1.180     matthew  2051: =cut
                   2052: 
                   2053: ###############################################################
                   2054: ###############################################################
                   2055: sub define_excel_formats {
                   2056:     my ($workbook) = @_;
                   2057:     my $format;
                   2058:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2059:                                                 bottom    => 1,
                   2060:                                                 align     => 'center');
                   2061:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2062:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2063:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2064:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2065:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2066:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2067:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2068:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2069:     return $format;
                   2070: }
                   2071: 
                   2072: ###############################################################
                   2073: ###############################################################
1.113     bowersj2 2074: 
                   2075: =pod
                   2076: 
1.648     raeburn  2077: =item * &create_workbook()
1.255     matthew  2078: 
                   2079: Create an Excel worksheet.  If it fails, output message on the
                   2080: request object and return undefs.
                   2081: 
                   2082: Inputs: Apache request object
                   2083: 
                   2084: Returns (undef) on failure, 
                   2085:     Excel worksheet object, scalar with filename, and formats 
                   2086:     from &Apache::loncommon::define_excel_formats on success
                   2087: 
                   2088: =cut
                   2089: 
                   2090: ###############################################################
                   2091: ###############################################################
                   2092: sub create_workbook {
                   2093:     my ($r) = @_;
                   2094:         #
                   2095:     # Create the excel spreadsheet
                   2096:     my $filename = '/prtspool/'.
1.258     albertel 2097:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2098:         time.'_'.rand(1000000000).'.xls';
                   2099:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2100:     if (! defined($workbook)) {
                   2101:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2102:         $r->print(
                   2103:             '<p class="LC_error">'
                   2104:            .&mt('Problems occurred in creating the new Excel file.')
                   2105:            .' '.&mt('This error has been logged.')
                   2106:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2107:            .'</p>'
                   2108:         );
1.255     matthew  2109:         return (undef);
                   2110:     }
                   2111:     #
1.1014    foxr     2112:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2113:     #
                   2114:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2115:     return ($workbook,$filename,$format);
                   2116: }
                   2117: 
                   2118: ###############################################################
                   2119: ###############################################################
                   2120: 
                   2121: =pod
                   2122: 
1.648     raeburn  2123: =item * &create_text_file()
1.113     bowersj2 2124: 
1.542     raeburn  2125: Create a file to write to and eventually make available to the user.
1.256     matthew  2126: If file creation fails, outputs an error message on the request object and 
                   2127: return undefs.
1.113     bowersj2 2128: 
1.256     matthew  2129: Inputs: Apache request object, and file suffix
1.113     bowersj2 2130: 
1.256     matthew  2131: Returns (undef) on failure, 
                   2132:     Filehandle and filename on success.
1.113     bowersj2 2133: 
                   2134: =cut
                   2135: 
1.256     matthew  2136: ###############################################################
                   2137: ###############################################################
                   2138: sub create_text_file {
                   2139:     my ($r,$suffix) = @_;
                   2140:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2141:     my $fh;
                   2142:     my $filename = '/prtspool/'.
1.258     albertel 2143:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2144:         time.'_'.rand(1000000000).'.'.$suffix;
                   2145:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2146:     if (! defined($fh)) {
                   2147:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2148:         $r->print(
                   2149:             '<p class="LC_error">'
                   2150:            .&mt('Problems occurred in creating the output file.')
                   2151:            .' '.&mt('This error has been logged.')
                   2152:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2153:            .'</p>'
                   2154:         );
1.113     bowersj2 2155:     }
1.256     matthew  2156:     return ($fh,$filename)
1.113     bowersj2 2157: }
                   2158: 
                   2159: 
1.256     matthew  2160: =pod 
1.113     bowersj2 2161: 
                   2162: =back
                   2163: 
                   2164: =cut
1.37      matthew  2165: 
                   2166: ###############################################################
1.33      matthew  2167: ##        Home server <option> list generating code          ##
                   2168: ###############################################################
1.35      matthew  2169: 
1.169     www      2170: # ------------------------------------------
                   2171: 
                   2172: sub domain_select {
                   2173:     my ($name,$value,$multiple)=@_;
                   2174:     my %domains=map { 
1.514     albertel 2175: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 2176:     } &Apache::lonnet::all_domains();
1.169     www      2177:     if ($multiple) {
                   2178: 	$domains{''}=&mt('Any domain');
1.550     albertel 2179: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2180: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2181:     } else {
1.550     albertel 2182: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2183: 	return &select_form($name,$value,\%domains);
1.169     www      2184:     }
                   2185: }
                   2186: 
1.282     albertel 2187: #-------------------------------------------
                   2188: 
                   2189: =pod
                   2190: 
1.519     raeburn  2191: =head1 Routines for form select boxes
                   2192: 
                   2193: =over 4
                   2194: 
1.648     raeburn  2195: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2196: 
                   2197: Returns a string containing a <select> element int multiple mode
                   2198: 
                   2199: 
                   2200: Args:
                   2201:   $name - name of the <select> element
1.506     raeburn  2202:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2203:   $size - number of rows long the select element is
1.283     albertel 2204:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2205:           (shown text should already have been &mt())
1.506     raeburn  2206:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2207: 
1.282     albertel 2208: =cut
                   2209: 
                   2210: #-------------------------------------------
1.169     www      2211: sub multiple_select_form {
1.284     albertel 2212:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2213:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2214:     my $output='';
1.191     matthew  2215:     if (! defined($size)) {
                   2216:         $size = 4;
1.283     albertel 2217:         if (scalar(keys(%$hash))<4) {
                   2218:             $size = scalar(keys(%$hash));
1.191     matthew  2219:         }
                   2220:     }
1.734     bisitz   2221:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2222:     my @order;
1.506     raeburn  2223:     if (ref($order) eq 'ARRAY')  {
                   2224:         @order = @{$order};
                   2225:     } else {
                   2226:         @order = sort(keys(%$hash));
1.501     banghart 2227:     }
                   2228:     if (exists($$hash{'select_form_order'})) {
                   2229:         @order = @{$$hash{'select_form_order'}};
                   2230:     }
                   2231:         
1.284     albertel 2232:     foreach my $key (@order) {
1.356     albertel 2233:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2234:         $output.='selected="selected" ' if ($selected{$key});
                   2235:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2236:     }
                   2237:     $output.="</select>\n";
                   2238:     return $output;
                   2239: }
                   2240: 
1.88      www      2241: #-------------------------------------------
                   2242: 
                   2243: =pod
                   2244: 
1.1075.2.115  raeburn  2245: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88      www      2246: 
                   2247: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2248: allow a user to select options from a ref to a hash containing:
                   2249: option_name => displayed text. An optional $onchange can include
1.1075.2.115  raeburn  2250: a javascript onchange item, e.g., onchange="this.form.submit();".
                   2251: An optional arg -- $readonly -- if true will cause the select form
                   2252: to be disabled, e.g., for the case where an instructor has a section-
                   2253: specific role, and is viewing/modifying parameters.  
1.970     raeburn  2254: 
1.88      www      2255: See lonrights.pm for an example invocation and use.
                   2256: 
                   2257: =cut
                   2258: 
                   2259: #-------------------------------------------
                   2260: sub select_form {
1.1075.2.115  raeburn  2261:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2262:     return unless (ref($hashref) eq 'HASH');
                   2263:     if ($onchange) {
                   2264:         $onchange = ' onchange="'.$onchange.'"';
                   2265:     }
1.1075.2.129  raeburn  2266:     my $disabled;
                   2267:     if ($readonly) {
                   2268:         $disabled = ' disabled="disabled"';
                   2269:     }
                   2270:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2271:     my @keys;
1.970     raeburn  2272:     if (exists($hashref->{'select_form_order'})) {
                   2273: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2274:     } else {
1.970     raeburn  2275: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2276:     }
1.356     albertel 2277:     foreach my $key (@keys) {
                   2278:         $selectform.=
                   2279: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2280:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2281:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2282:     }
                   2283:     $selectform.="</select>";
                   2284:     return $selectform;
                   2285: }
                   2286: 
1.475     www      2287: # For display filters
                   2288: 
                   2289: sub display_filter {
1.1074    raeburn  2290:     my ($context) = @_;
1.475     www      2291:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2292:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2293:     my $phraseinput = 'hidden';
                   2294:     my $includeinput = 'hidden';
                   2295:     my ($checked,$includetypestext);
                   2296:     if ($env{'form.displayfilter'} eq 'containing') {
                   2297:         $phraseinput = 'text'; 
                   2298:         if ($context eq 'parmslog') {
                   2299:             $includeinput = 'checkbox';
                   2300:             if ($env{'form.includetypes'}) {
                   2301:                 $checked = ' checked="checked"';
                   2302:             }
                   2303:             $includetypestext = &mt('Include parameter types');
                   2304:         }
                   2305:     } else {
                   2306:         $includetypestext = '&nbsp;';
                   2307:     }
                   2308:     my ($additional,$secondid,$thirdid);
                   2309:     if ($context eq 'parmslog') {
                   2310:         $additional = 
                   2311:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2312:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2313:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2314:             '</label>';
                   2315:         $secondid = 'includetypes';
                   2316:         $thirdid = 'includetypestext';
                   2317:     }
                   2318:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2319:                                                     '$secondid','$thirdid')";
                   2320:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2321: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2322: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2323: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2324:            &mt('Filter: [_1]',
1.477     www      2325: 	   &select_form($env{'form.displayfilter'},
                   2326: 			'displayfilter',
1.970     raeburn  2327: 			{'currentfolder' => 'Current folder/page',
1.477     www      2328: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2329: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2330: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2331:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2332:                          '" />'.$additional;
                   2333: }
                   2334: 
                   2335: sub display_filter_js {
                   2336:     my $includetext = &mt('Include parameter types');
                   2337:     return <<"ENDJS";
                   2338:   
                   2339: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2340:     var firstType = 'hidden';
                   2341:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2342:         firstType = 'text';
                   2343:     }
                   2344:     firstObject = document.getElementById(firstid);
                   2345:     if (typeof(firstObject) == 'object') {
                   2346:         if (firstObject.type != firstType) {
                   2347:             changeInputType(firstObject,firstType);
                   2348:         }
                   2349:     }
                   2350:     if (context == 'parmslog') {
                   2351:         var secondType = 'hidden';
                   2352:         if (firstType == 'text') {
                   2353:             secondType = 'checkbox';
                   2354:         }
                   2355:         secondObject = document.getElementById(secondid);  
                   2356:         if (typeof(secondObject) == 'object') {
                   2357:             if (secondObject.type != secondType) {
                   2358:                 changeInputType(secondObject,secondType);
                   2359:             }
                   2360:         }
                   2361:         var textItem = document.getElementById(thirdid);
                   2362:         var currtext = textItem.innerHTML;
                   2363:         var newtext;
                   2364:         if (firstType == 'text') {
                   2365:             newtext = '$includetext';
                   2366:         } else {
                   2367:             newtext = '&nbsp;';
                   2368:         }
                   2369:         if (currtext != newtext) {
                   2370:             textItem.innerHTML = newtext;
                   2371:         }
                   2372:     }
                   2373:     return;
                   2374: }
                   2375: 
                   2376: function changeInputType(oldObject,newType) {
                   2377:     var newObject = document.createElement('input');
                   2378:     newObject.type = newType;
                   2379:     if (oldObject.size) {
                   2380:         newObject.size = oldObject.size;
                   2381:     }
                   2382:     if (oldObject.value) {
                   2383:         newObject.value = oldObject.value;
                   2384:     }
                   2385:     if (oldObject.name) {
                   2386:         newObject.name = oldObject.name;
                   2387:     }
                   2388:     if (oldObject.id) {
                   2389:         newObject.id = oldObject.id;
                   2390:     }
                   2391:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2392:     return;
                   2393: }
                   2394: 
                   2395: ENDJS
1.475     www      2396: }
                   2397: 
1.167     www      2398: sub gradeleveldescription {
                   2399:     my $gradelevel=shift;
                   2400:     my %gradelevels=(0 => 'Not specified',
                   2401: 		     1 => 'Grade 1',
                   2402: 		     2 => 'Grade 2',
                   2403: 		     3 => 'Grade 3',
                   2404: 		     4 => 'Grade 4',
                   2405: 		     5 => 'Grade 5',
                   2406: 		     6 => 'Grade 6',
                   2407: 		     7 => 'Grade 7',
                   2408: 		     8 => 'Grade 8',
                   2409: 		     9 => 'Grade 9',
                   2410: 		     10 => 'Grade 10',
                   2411: 		     11 => 'Grade 11',
                   2412: 		     12 => 'Grade 12',
                   2413: 		     13 => 'Grade 13',
                   2414: 		     14 => '100 Level',
                   2415: 		     15 => '200 Level',
                   2416: 		     16 => '300 Level',
                   2417: 		     17 => '400 Level',
                   2418: 		     18 => 'Graduate Level');
                   2419:     return &mt($gradelevels{$gradelevel});
                   2420: }
                   2421: 
1.163     www      2422: sub select_level_form {
                   2423:     my ($deflevel,$name)=@_;
                   2424:     unless ($deflevel) { $deflevel=0; }
1.167     www      2425:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2426:     for (my $i=0; $i<=18; $i++) {
                   2427:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2428:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2429:                 ">".&gradeleveldescription($i)."</option>\n";
                   2430:     }
                   2431:     $selectform.="</select>";
                   2432:     return $selectform;
1.163     www      2433: }
1.167     www      2434: 
1.35      matthew  2435: #-------------------------------------------
                   2436: 
1.45      matthew  2437: =pod
                   2438: 
1.1075.2.115  raeburn  2439: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35      matthew  2440: 
                   2441: Returns a string containing a <select name='$name' size='1'> form to 
                   2442: allow a user to select the domain to preform an operation in.  
                   2443: See loncreateuser.pm for an example invocation and use.
                   2444: 
1.90      www      2445: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2446: selected");
                   2447: 
1.743     raeburn  2448: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2449: 
1.910     raeburn  2450: 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.
                   2451: 
1.1075.2.36  raeburn  2452: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2453: 
1.1075.2.115  raeburn  2454: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
                   2455: 
                   2456: The optional $disabled argument, if true, adds the disabled attribute to the select tag. 
1.563     raeburn  2457: 
1.35      matthew  2458: =cut
                   2459: 
                   2460: #-------------------------------------------
1.34      matthew  2461: sub select_dom_form {
1.1075.2.115  raeburn  2462:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872     raeburn  2463:     if ($onchange) {
1.874     raeburn  2464:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2465:     }
1.1075.2.115  raeburn  2466:     if ($disabled) {
                   2467:         $disabled = ' disabled="disabled"';
                   2468:     }
1.1075.2.36  raeburn  2469:     my (@domains,%exclude);
1.910     raeburn  2470:     if (ref($incdoms) eq 'ARRAY') {
                   2471:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2472:     } else {
                   2473:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2474:     }
1.90      www      2475:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2476:     if (ref($excdoms) eq 'ARRAY') {
                   2477:         map { $exclude{$_} = 1; } @{$excdoms};
                   2478:     }
1.1075.2.115  raeburn  2479:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356     albertel 2480:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2481:         next if ($exclude{$dom});
1.356     albertel 2482:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2483:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2484:         if ($showdomdesc) {
                   2485:             if ($dom ne '') {
                   2486:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2487:                 if ($domdesc ne '') {
                   2488:                     $selectdomain .= ' ('.$domdesc.')';
                   2489:                 }
                   2490:             } 
                   2491:         }
                   2492:         $selectdomain .= "</option>\n";
1.34      matthew  2493:     }
                   2494:     $selectdomain.="</select>";
                   2495:     return $selectdomain;
                   2496: }
                   2497: 
1.35      matthew  2498: #-------------------------------------------
                   2499: 
1.45      matthew  2500: =pod
                   2501: 
1.648     raeburn  2502: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2503: 
1.586     raeburn  2504: input: 4 arguments (two required, two optional) - 
                   2505:     $domain - domain of new user
                   2506:     $name - name of form element
                   2507:     $default - Value of 'default' causes a default item to be first 
                   2508:                             option, and selected by default. 
                   2509:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2510:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2511: output: returns 2 items: 
1.586     raeburn  2512: (a) form element which contains either:
                   2513:    (i) <select name="$name">
                   2514:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2515:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2516:        </select>
                   2517:        form item if there are multiple library servers in $domain, or
                   2518:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2519:        if there is only one library server in $domain.
                   2520: 
                   2521: (b) number of library servers found.
                   2522: 
                   2523: See loncreateuser.pm for example of use.
1.35      matthew  2524: 
                   2525: =cut
                   2526: 
                   2527: #-------------------------------------------
1.586     raeburn  2528: sub home_server_form_item {
                   2529:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2530:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2531:     my $result;
                   2532:     my $numlib = keys(%servers);
                   2533:     if ($numlib > 1) {
                   2534:         $result .= '<select name="'.$name.'" />'."\n";
                   2535:         if ($default) {
1.804     bisitz   2536:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2537:                        '</option>'."\n";
                   2538:         }
                   2539:         foreach my $hostid (sort(keys(%servers))) {
                   2540:             $result.= '<option value="'.$hostid.'">'.
                   2541: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2542:         }
                   2543:         $result .= '</select>'."\n";
                   2544:     } elsif ($numlib == 1) {
                   2545:         my $hostid;
                   2546:         foreach my $item (keys(%servers)) {
                   2547:             $hostid = $item;
                   2548:         }
                   2549:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2550:                    $hostid.'" />';
                   2551:                    if (!$hide) {
                   2552:                        $result .= $hostid.' '.$servers{$hostid};
                   2553:                    }
                   2554:                    $result .= "\n";
                   2555:     } elsif ($default) {
                   2556:         $result .= '<input type="hidden" name="'.$name.
                   2557:                    '" value="default" />';
                   2558:                    if (!$hide) {
                   2559:                        $result .= &mt('default');
                   2560:                    }
                   2561:                    $result .= "\n";
1.33      matthew  2562:     }
1.586     raeburn  2563:     return ($result,$numlib);
1.33      matthew  2564: }
1.112     bowersj2 2565: 
                   2566: =pod
                   2567: 
1.534     albertel 2568: =back 
                   2569: 
1.112     bowersj2 2570: =cut
1.87      matthew  2571: 
                   2572: ###############################################################
1.112     bowersj2 2573: ##                  Decoding User Agent                      ##
1.87      matthew  2574: ###############################################################
                   2575: 
                   2576: =pod
                   2577: 
1.112     bowersj2 2578: =head1 Decoding the User Agent
                   2579: 
                   2580: =over 4
                   2581: 
                   2582: =item * &decode_user_agent()
1.87      matthew  2583: 
                   2584: Inputs: $r
                   2585: 
                   2586: Outputs:
                   2587: 
                   2588: =over 4
                   2589: 
1.112     bowersj2 2590: =item * $httpbrowser
1.87      matthew  2591: 
1.112     bowersj2 2592: =item * $clientbrowser
1.87      matthew  2593: 
1.112     bowersj2 2594: =item * $clientversion
1.87      matthew  2595: 
1.112     bowersj2 2596: =item * $clientmathml
1.87      matthew  2597: 
1.112     bowersj2 2598: =item * $clientunicode
1.87      matthew  2599: 
1.112     bowersj2 2600: =item * $clientos
1.87      matthew  2601: 
1.1075.2.42  raeburn  2602: =item * $clientmobile
                   2603: 
                   2604: =item * $clientinfo
                   2605: 
1.1075.2.77  raeburn  2606: =item * $clientosversion
                   2607: 
1.87      matthew  2608: =back
                   2609: 
1.157     matthew  2610: =back 
                   2611: 
1.87      matthew  2612: =cut
                   2613: 
                   2614: ###############################################################
                   2615: ###############################################################
                   2616: sub decode_user_agent {
1.247     albertel 2617:     my ($r)=@_;
1.87      matthew  2618:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2619:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2620:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2621:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2622:     my $clientbrowser='unknown';
                   2623:     my $clientversion='0';
                   2624:     my $clientmathml='';
                   2625:     my $clientunicode='0';
1.1075.2.42  raeburn  2626:     my $clientmobile=0;
1.1075.2.77  raeburn  2627:     my $clientosversion='';
1.87      matthew  2628:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76  raeburn  2629:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2630: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2631: 	    $clientbrowser=$bname;
                   2632:             $httpbrowser=~/$vreg/i;
                   2633: 	    $clientversion=$1;
                   2634:             $clientmathml=($clientversion>=$minv);
                   2635:             $clientunicode=($clientversion>=$univ);
                   2636: 	}
                   2637:     }
                   2638:     my $clientos='unknown';
1.1075.2.42  raeburn  2639:     my $clientinfo;
1.87      matthew  2640:     if (($httpbrowser=~/linux/i) ||
                   2641:         ($httpbrowser=~/unix/i) ||
                   2642:         ($httpbrowser=~/ux/i) ||
                   2643:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2644:     if (($httpbrowser=~/vax/i) ||
                   2645:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2646:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2647:     if (($httpbrowser=~/mac/i) ||
                   2648:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77  raeburn  2649:     if ($httpbrowser=~/win/i) {
                   2650:         $clientos='win';
                   2651:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2652:             $clientosversion = $1;
                   2653:         }
                   2654:     }
1.87      matthew  2655:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2656:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2657:         $clientmobile=lc($1);
                   2658:     }
                   2659:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2660:         $clientinfo = 'firefox-'.$1;
                   2661:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2662:         $clientinfo = 'chromeframe-'.$1;
                   2663:     }
1.87      matthew  2664:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77  raeburn  2665:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2666:             $clientosversion);
1.87      matthew  2667: }
                   2668: 
1.32      matthew  2669: ###############################################################
                   2670: ##    Authentication changing form generation subroutines    ##
                   2671: ###############################################################
                   2672: ##
                   2673: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2674: ## hash, and have reasonable default values.
                   2675: ##
                   2676: ##    formname = the name given in the <form> tag.
1.35      matthew  2677: #-------------------------------------------
                   2678: 
1.45      matthew  2679: =pod
                   2680: 
1.112     bowersj2 2681: =head1 Authentication Routines
                   2682: 
                   2683: =over 4
                   2684: 
1.648     raeburn  2685: =item * &authform_xxxxxx()
1.35      matthew  2686: 
                   2687: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2688: handle some of the conveniences required for authentication forms.  
                   2689: This is not an optimal method, but it works.  
                   2690: 
                   2691: =over 4
                   2692: 
1.112     bowersj2 2693: =item * authform_header
1.35      matthew  2694: 
1.112     bowersj2 2695: =item * authform_authorwarning
1.35      matthew  2696: 
1.112     bowersj2 2697: =item * authform_nochange
1.35      matthew  2698: 
1.112     bowersj2 2699: =item * authform_kerberos
1.35      matthew  2700: 
1.112     bowersj2 2701: =item * authform_internal
1.35      matthew  2702: 
1.112     bowersj2 2703: =item * authform_filesystem
1.35      matthew  2704: 
                   2705: =back
                   2706: 
1.648     raeburn  2707: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2708: 
1.35      matthew  2709: =cut
                   2710: 
                   2711: #-------------------------------------------
1.32      matthew  2712: sub authform_header{  
                   2713:     my %in = (
                   2714:         formname => 'cu',
1.80      albertel 2715:         kerb_def_dom => '',
1.32      matthew  2716:         @_,
                   2717:     );
                   2718:     $in{'formname'} = 'document.' . $in{'formname'};
                   2719:     my $result='';
1.80      albertel 2720: 
                   2721: #---------------------------------------------- Code for upper case translation
                   2722:     my $Javascript_toUpperCase;
                   2723:     unless ($in{kerb_def_dom}) {
                   2724:         $Javascript_toUpperCase =<<"END";
                   2725:         switch (choice) {
                   2726:            case 'krb': currentform.elements[choicearg].value =
                   2727:                currentform.elements[choicearg].value.toUpperCase();
                   2728:                break;
                   2729:            default:
                   2730:         }
                   2731: END
                   2732:     } else {
                   2733:         $Javascript_toUpperCase = "";
                   2734:     }
                   2735: 
1.165     raeburn  2736:     my $radioval = "'nochange'";
1.591     raeburn  2737:     if (defined($in{'curr_authtype'})) {
                   2738:         if ($in{'curr_authtype'} ne '') {
                   2739:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2740:         }
1.174     matthew  2741:     }
1.165     raeburn  2742:     my $argfield = 'null';
1.591     raeburn  2743:     if (defined($in{'mode'})) {
1.165     raeburn  2744:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2745:             if (defined($in{'curr_autharg'})) {
                   2746:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2747:                     $argfield = "'$in{'curr_autharg'}'";
                   2748:                 }
                   2749:             }
                   2750:         }
                   2751:     }
                   2752: 
1.32      matthew  2753:     $result.=<<"END";
                   2754: var current = new Object();
1.165     raeburn  2755: current.radiovalue = $radioval;
                   2756: current.argfield = $argfield;
1.32      matthew  2757: 
                   2758: function changed_radio(choice,currentform) {
                   2759:     var choicearg = choice + 'arg';
                   2760:     // If a radio button in changed, we need to change the argfield
                   2761:     if (current.radiovalue != choice) {
                   2762:         current.radiovalue = choice;
                   2763:         if (current.argfield != null) {
                   2764:             currentform.elements[current.argfield].value = '';
                   2765:         }
                   2766:         if (choice == 'nochange') {
                   2767:             current.argfield = null;
                   2768:         } else {
                   2769:             current.argfield = choicearg;
                   2770:             switch(choice) {
                   2771:                 case 'krb': 
                   2772:                     currentform.elements[current.argfield].value = 
                   2773:                         "$in{'kerb_def_dom'}";
                   2774:                 break;
                   2775:               default:
                   2776:                 break;
                   2777:             }
                   2778:         }
                   2779:     }
                   2780:     return;
                   2781: }
1.22      www      2782: 
1.32      matthew  2783: function changed_text(choice,currentform) {
                   2784:     var choicearg = choice + 'arg';
                   2785:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2786:         $Javascript_toUpperCase
1.32      matthew  2787:         // clear old field
                   2788:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2789:             currentform.elements[current.argfield].value = '';
                   2790:         }
                   2791:         current.argfield = choicearg;
                   2792:     }
                   2793:     set_auth_radio_buttons(choice,currentform);
                   2794:     return;
1.20      www      2795: }
1.32      matthew  2796: 
                   2797: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2798:     var numauthchoices = currentform.login.length;
                   2799:     if (typeof numauthchoices  == "undefined") {
                   2800:         return;
                   2801:     } 
1.32      matthew  2802:     var i=0;
1.986     raeburn  2803:     while (i < numauthchoices) {
1.32      matthew  2804:         if (currentform.login[i].value == newvalue) { break; }
                   2805:         i++;
                   2806:     }
1.986     raeburn  2807:     if (i == numauthchoices) {
1.32      matthew  2808:         return;
                   2809:     }
                   2810:     current.radiovalue = newvalue;
                   2811:     currentform.login[i].checked = true;
                   2812:     return;
                   2813: }
                   2814: END
                   2815:     return $result;
                   2816: }
                   2817: 
1.1075.2.20  raeburn  2818: sub authform_authorwarning {
1.32      matthew  2819:     my $result='';
1.144     matthew  2820:     $result='<i>'.
                   2821:         &mt('As a general rule, only authors or co-authors should be '.
                   2822:             'filesystem authenticated '.
                   2823:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2824:     return $result;
                   2825: }
                   2826: 
1.1075.2.20  raeburn  2827: sub authform_nochange {
1.32      matthew  2828:     my %in = (
                   2829:               formname => 'document.cu',
                   2830:               kerb_def_dom => 'MSU.EDU',
                   2831:               @_,
                   2832:           );
1.1075.2.20  raeburn  2833:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2834:     my $result;
1.1075.2.20  raeburn  2835:     if (!$authnum) {
                   2836:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2837:     } else {
                   2838:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2839:                   '<input type="radio" name="login" value="nochange" '.
                   2840:                   'checked="checked" onclick="'.
1.281     albertel 2841:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2842: 	    '</label>';
1.586     raeburn  2843:     }
1.32      matthew  2844:     return $result;
                   2845: }
                   2846: 
1.591     raeburn  2847: sub authform_kerberos {
1.32      matthew  2848:     my %in = (
                   2849:               formname => 'document.cu',
                   2850:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2851:               kerb_def_auth => 'krb4',
1.32      matthew  2852:               @_,
                   2853:               );
1.586     raeburn  2854:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1075.2.117  raeburn  2855:         $autharg,$jscall,$disabled);
1.1075.2.20  raeburn  2856:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2857:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2858:        $check5 = ' checked="checked"';
1.80      albertel 2859:     } else {
1.772     bisitz   2860:        $check4 = ' checked="checked"';
1.80      albertel 2861:     }
1.1075.2.117  raeburn  2862:     if ($in{'readonly'}) {
                   2863:         $disabled = ' disabled="disabled"';
                   2864:     }
1.165     raeburn  2865:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2866:     if (defined($in{'curr_authtype'})) {
                   2867:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2868:             $krbcheck = ' checked="checked"';
1.623     raeburn  2869:             if (defined($in{'mode'})) {
                   2870:                 if ($in{'mode'} eq 'modifyuser') {
                   2871:                     $krbcheck = '';
                   2872:                 }
                   2873:             }
1.591     raeburn  2874:             if (defined($in{'curr_kerb_ver'})) {
                   2875:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2876:                     $check5 = ' checked="checked"';
1.591     raeburn  2877:                     $check4 = '';
                   2878:                 } else {
1.772     bisitz   2879:                     $check4 = ' checked="checked"';
1.591     raeburn  2880:                     $check5 = '';
                   2881:                 }
1.586     raeburn  2882:             }
1.591     raeburn  2883:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2884:                 $krbarg = $in{'curr_autharg'};
                   2885:             }
1.586     raeburn  2886:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2887:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2888:                     $result = 
                   2889:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2890:         $in{'curr_autharg'},$krbver);
                   2891:                 } else {
                   2892:                     $result =
                   2893:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2894:                 }
                   2895:                 return $result; 
                   2896:             }
                   2897:         }
                   2898:     } else {
                   2899:         if ($authnum == 1) {
1.784     bisitz   2900:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2901:         }
                   2902:     }
1.586     raeburn  2903:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2904:         return;
1.587     raeburn  2905:     } elsif ($authtype eq '') {
1.591     raeburn  2906:         if (defined($in{'mode'})) {
1.587     raeburn  2907:             if ($in{'mode'} eq 'modifycourse') {
                   2908:                 if ($authnum == 1) {
1.1075.2.117  raeburn  2909:                     $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587     raeburn  2910:                 }
                   2911:             }
                   2912:         }
1.586     raeburn  2913:     }
                   2914:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2915:     if ($authtype eq '') {
                   2916:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2917:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1075.2.117  raeburn  2918:                     $krbcheck.$disabled.' />';
1.586     raeburn  2919:     }
                   2920:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2921:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2922:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2923:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2924:          $in{'curr_authtype'} eq 'krb4')) {
                   2925:         $result .= &mt
1.144     matthew  2926:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2927:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2928:          '<label>'.$authtype,
1.281     albertel 2929:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2930:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  2931:              'onchange="'.$jscall.'"'.$disabled.' />',
                   2932:          '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
                   2933:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281     albertel 2934: 	 '</label>');
1.586     raeburn  2935:     } elsif ($can_assign{'krb4'}) {
                   2936:         $result .= &mt
                   2937:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2938:          '[_3] Version 4 [_4]',
                   2939:          '<label>'.$authtype,
                   2940:          '</label><input type="text" size="10" name="krbarg" '.
                   2941:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  2942:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  2943:          '<label><input type="hidden" name="krbver" value="4" />',
                   2944:          '</label>');
                   2945:     } elsif ($can_assign{'krb5'}) {
                   2946:         $result .= &mt
                   2947:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2948:          '[_3] Version 5 [_4]',
                   2949:          '<label>'.$authtype,
                   2950:          '</label><input type="text" size="10" name="krbarg" '.
                   2951:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  2952:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  2953:          '<label><input type="hidden" name="krbver" value="5" />',
                   2954:          '</label>');
                   2955:     }
1.32      matthew  2956:     return $result;
                   2957: }
                   2958: 
1.1075.2.20  raeburn  2959: sub authform_internal {
1.586     raeburn  2960:     my %in = (
1.32      matthew  2961:                 formname => 'document.cu',
                   2962:                 kerb_def_dom => 'MSU.EDU',
                   2963:                 @_,
                   2964:                 );
1.1075.2.117  raeburn  2965:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  2966:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  2967:     if ($in{'readonly'}) {
                   2968:         $disabled = ' disabled="disabled"';
                   2969:     }
1.591     raeburn  2970:     if (defined($in{'curr_authtype'})) {
                   2971:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2972:             if ($can_assign{'int'}) {
1.772     bisitz   2973:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2974:                 if (defined($in{'mode'})) {
                   2975:                     if ($in{'mode'} eq 'modifyuser') {
                   2976:                         $intcheck = '';
                   2977:                     }
                   2978:                 }
1.591     raeburn  2979:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2980:                     $intarg = $in{'curr_autharg'};
                   2981:                 }
                   2982:             } else {
                   2983:                 $result = &mt('Currently internally authenticated.');
                   2984:                 return $result;
1.165     raeburn  2985:             }
                   2986:         }
1.586     raeburn  2987:     } else {
                   2988:         if ($authnum == 1) {
1.784     bisitz   2989:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2990:         }
                   2991:     }
                   2992:     if (!$can_assign{'int'}) {
                   2993:         return;
1.587     raeburn  2994:     } elsif ($authtype eq '') {
1.591     raeburn  2995:         if (defined($in{'mode'})) {
1.587     raeburn  2996:             if ($in{'mode'} eq 'modifycourse') {
                   2997:                 if ($authnum == 1) {
1.1075.2.117  raeburn  2998:                     $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587     raeburn  2999:                 }
                   3000:             }
                   3001:         }
1.165     raeburn  3002:     }
1.586     raeburn  3003:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3004:     if ($authtype eq '') {
                   3005:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1075.2.117  raeburn  3006:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3007:     }
1.605     bisitz   3008:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1075.2.117  raeburn  3009:                $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3010:     $result = &mt
1.144     matthew  3011:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3012:          '<label>'.$authtype,'</label>'.$autharg);
1.1075.2.118  raeburn  3013:     $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
1.32      matthew  3014:     return $result;
                   3015: }
                   3016: 
1.1075.2.20  raeburn  3017: sub authform_local {
1.32      matthew  3018:     my %in = (
                   3019:               formname => 'document.cu',
                   3020:               kerb_def_dom => 'MSU.EDU',
                   3021:               @_,
                   3022:               );
1.1075.2.117  raeburn  3023:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  3024:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  3025:     if ($in{'readonly'}) {
                   3026:         $disabled = ' disabled="disabled"';
                   3027:     }
1.591     raeburn  3028:     if (defined($in{'curr_authtype'})) {
                   3029:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3030:             if ($can_assign{'loc'}) {
1.772     bisitz   3031:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3032:                 if (defined($in{'mode'})) {
                   3033:                     if ($in{'mode'} eq 'modifyuser') {
                   3034:                         $loccheck = '';
                   3035:                     }
                   3036:                 }
1.591     raeburn  3037:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3038:                     $locarg = $in{'curr_autharg'};
                   3039:                 }
                   3040:             } else {
                   3041:                 $result = &mt('Currently using local (institutional) authentication.');
                   3042:                 return $result;
1.165     raeburn  3043:             }
                   3044:         }
1.586     raeburn  3045:     } else {
                   3046:         if ($authnum == 1) {
1.784     bisitz   3047:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3048:         }
                   3049:     }
                   3050:     if (!$can_assign{'loc'}) {
                   3051:         return;
1.587     raeburn  3052:     } elsif ($authtype eq '') {
1.591     raeburn  3053:         if (defined($in{'mode'})) {
1.587     raeburn  3054:             if ($in{'mode'} eq 'modifycourse') {
                   3055:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3056:                     $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587     raeburn  3057:                 }
                   3058:             }
                   3059:         }
1.165     raeburn  3060:     }
1.586     raeburn  3061:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3062:     if ($authtype eq '') {
                   3063:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3064:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117  raeburn  3065:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3066:     }
                   3067:     $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1075.2.117  raeburn  3068:                $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3069:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3070:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3071:     return $result;
                   3072: }
                   3073: 
1.1075.2.20  raeburn  3074: sub authform_filesystem {
1.32      matthew  3075:     my %in = (
                   3076:               formname => 'document.cu',
                   3077:               kerb_def_dom => 'MSU.EDU',
                   3078:               @_,
                   3079:               );
1.1075.2.117  raeburn  3080:     my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  3081:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  3082:     if ($in{'readonly'}) {
                   3083:         $disabled = ' disabled="disabled"';
                   3084:     }
1.591     raeburn  3085:     if (defined($in{'curr_authtype'})) {
                   3086:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3087:             if ($can_assign{'fsys'}) {
1.772     bisitz   3088:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3089:                 if (defined($in{'mode'})) {
                   3090:                     if ($in{'mode'} eq 'modifyuser') {
                   3091:                         $fsyscheck = '';
                   3092:                     }
                   3093:                 }
1.586     raeburn  3094:             } else {
                   3095:                 $result = &mt('Currently Filesystem Authenticated.');
                   3096:                 return $result;
                   3097:             }           
                   3098:         }
                   3099:     } else {
                   3100:         if ($authnum == 1) {
1.784     bisitz   3101:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3102:         }
                   3103:     }
                   3104:     if (!$can_assign{'fsys'}) {
                   3105:         return;
1.587     raeburn  3106:     } elsif ($authtype eq '') {
1.591     raeburn  3107:         if (defined($in{'mode'})) {
1.587     raeburn  3108:             if ($in{'mode'} eq 'modifycourse') {
                   3109:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3110:                     $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587     raeburn  3111:                 }
                   3112:             }
                   3113:         }
1.586     raeburn  3114:     }
                   3115:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3116:     if ($authtype eq '') {
                   3117:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3118:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117  raeburn  3119:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3120:     }
                   3121:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
1.1075.2.117  raeburn  3122:                ' onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3123:     $result = &mt
1.144     matthew  3124:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 3125:          '<label><input type="radio" name="login" value="fsys" '.
1.1075.2.117  raeburn  3126:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
1.605     bisitz   3127:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.1075.2.117  raeburn  3128:                   'onchange="'.$jscall.'"'.$disabled.' />');
1.32      matthew  3129:     return $result;
                   3130: }
                   3131: 
1.586     raeburn  3132: sub get_assignable_auth {
                   3133:     my ($dom) = @_;
                   3134:     if ($dom eq '') {
                   3135:         $dom = $env{'request.role.domain'};
                   3136:     }
                   3137:     my %can_assign = (
                   3138:                           krb4 => 1,
                   3139:                           krb5 => 1,
                   3140:                           int  => 1,
                   3141:                           loc  => 1,
                   3142:                      );
                   3143:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3144:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3145:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3146:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3147:             my $context;
                   3148:             if ($env{'request.role'} =~ /^au/) {
                   3149:                 $context = 'author';
1.1075.2.117  raeburn  3150:             } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586     raeburn  3151:                 $context = 'domain';
                   3152:             } elsif ($env{'request.course.id'}) {
                   3153:                 $context = 'course';
                   3154:             }
                   3155:             if ($context) {
                   3156:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3157:                    %can_assign = %{$authhash->{$context}}; 
                   3158:                 }
                   3159:             }
                   3160:         }
                   3161:     }
                   3162:     my $authnum = 0;
                   3163:     foreach my $key (keys(%can_assign)) {
                   3164:         if ($can_assign{$key}) {
                   3165:             $authnum ++;
                   3166:         }
                   3167:     }
                   3168:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3169:         $authnum --;
                   3170:     }
                   3171:     return ($authnum,%can_assign);
                   3172: }
                   3173: 
1.1075.2.137  raeburn  3174: sub check_passwd_rules {
                   3175:     my ($domain,$plainpass) = @_;
                   3176:     my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3177:     my ($min,$max,@chars,@brokerule,$warning);
1.1075.2.138  raeburn  3178:     $min = $Apache::lonnet::passwdmin;
1.1075.2.137  raeburn  3179:     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3180:         if ($passwdconf{'min'} =~ /^\d+$/) {
1.1075.2.138  raeburn  3181:             if ($passwdconf{'min'} > $min) {
                   3182:                 $min = $passwdconf{'min'};
                   3183:             }
1.1075.2.137  raeburn  3184:         }
                   3185:         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3186:             $max = $passwdconf{'max'};
                   3187:         }
                   3188:         @chars = @{$passwdconf{'chars'}};
                   3189:     }
                   3190:     if (($min) && (length($plainpass) < $min)) {
                   3191:         push(@brokerule,'min');
                   3192:     }
                   3193:     if (($max) && (length($plainpass) > $max)) {
                   3194:         push(@brokerule,'max');
                   3195:     }
                   3196:     if (@chars) {
                   3197:         my %rules;
                   3198:         map { $rules{$_} = 1; } @chars;
                   3199:         if ($rules{'uc'}) {
                   3200:             unless ($plainpass =~ /[A-Z]/) {
                   3201:                 push(@brokerule,'uc');
                   3202:             }
                   3203:         }
                   3204:         if ($rules{'lc'}) {
                   3205:             unless ($plainpass =~ /[a-z]/) {
                   3206:                 push(@brokerule,'lc');
                   3207:             }
                   3208:         }
                   3209:         if ($rules{'num'}) {
                   3210:             unless ($plainpass =~ /\d/) {
                   3211:                 push(@brokerule,'num');
                   3212:             }
                   3213:         }
                   3214:         if ($rules{'spec'}) {
                   3215:             unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   3216:                 push(@brokerule,'spec');
                   3217:             }
                   3218:         }
                   3219:     }
                   3220:     if (@brokerule) {
                   3221:         my %rulenames = &Apache::lonlocal::texthash(
                   3222:             uc   => 'At least one upper case letter',
                   3223:             lc   => 'At least one lower case letter',
                   3224:             num  => 'At least one number',
                   3225:             spec => 'At least one non-alphanumeric',
                   3226:         );
                   3227:         $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
                   3228:         $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
                   3229:         $rulenames{'num'} .= ': 0123456789';
                   3230:         $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
                   3231:         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
                   3232:         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
                   3233:         $warning = &mt('Password did not satisfy the following:').'<ul>';
                   3234:         foreach my $rule ('min','max','uc','ls','num','spec') {
                   3235:             if (grep(/^$rule$/,@brokerule)) {
                   3236:                 $warning .= '<li>'.$rulenames{$rule}.'</li>';
                   3237:             }
                   3238:         }
                   3239:         $warning .= '</ul>';
                   3240:     }
                   3241:     if (wantarray) {
                   3242:         return @brokerule;
                   3243:     }
                   3244:     return $warning;
                   3245: }
                   3246: 
1.80      albertel 3247: ###############################################################
                   3248: ##    Get Kerberos Defaults for Domain                 ##
                   3249: ###############################################################
                   3250: ##
                   3251: ## Returns default kerberos version and an associated argument
                   3252: ## as listed in file domain.tab. If not listed, provides
                   3253: ## appropriate default domain and kerberos version.
                   3254: ##
                   3255: #-------------------------------------------
                   3256: 
                   3257: =pod
                   3258: 
1.648     raeburn  3259: =item * &get_kerberos_defaults()
1.80      albertel 3260: 
                   3261: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3262: version and domain. If not found, it defaults to version 4 and the 
                   3263: domain of the server.
1.80      albertel 3264: 
1.648     raeburn  3265: =over 4
                   3266: 
1.80      albertel 3267: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3268: 
1.648     raeburn  3269: =back
                   3270: 
                   3271: =back
                   3272: 
1.80      albertel 3273: =cut
                   3274: 
                   3275: #-------------------------------------------
                   3276: sub get_kerberos_defaults {
                   3277:     my $domain=shift;
1.641     raeburn  3278:     my ($krbdef,$krbdefdom);
                   3279:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3280:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3281:         $krbdef = $domdefaults{'auth_def'};
                   3282:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3283:     } else {
1.80      albertel 3284:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3285:         my $krbdefdom=$1;
                   3286:         $krbdefdom=~tr/a-z/A-Z/;
                   3287:         $krbdef = "krb4";
                   3288:     }
                   3289:     return ($krbdef,$krbdefdom);
                   3290: }
1.112     bowersj2 3291: 
1.32      matthew  3292: 
1.46      matthew  3293: ###############################################################
                   3294: ##                Thesaurus Functions                        ##
                   3295: ###############################################################
1.20      www      3296: 
1.46      matthew  3297: =pod
1.20      www      3298: 
1.112     bowersj2 3299: =head1 Thesaurus Functions
                   3300: 
                   3301: =over 4
                   3302: 
1.648     raeburn  3303: =item * &initialize_keywords()
1.46      matthew  3304: 
                   3305: Initializes the package variable %Keywords if it is empty.  Uses the
                   3306: package variable $thesaurus_db_file.
                   3307: 
                   3308: =cut
                   3309: 
                   3310: ###################################################
                   3311: 
                   3312: sub initialize_keywords {
                   3313:     return 1 if (scalar keys(%Keywords));
                   3314:     # If we are here, %Keywords is empty, so fill it up
                   3315:     #   Make sure the file we need exists...
                   3316:     if (! -e $thesaurus_db_file) {
                   3317:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3318:                                  " failed because it does not exist");
                   3319:         return 0;
                   3320:     }
                   3321:     #   Set up the hash as a database
                   3322:     my %thesaurus_db;
                   3323:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3324:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3325:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3326:                                  $thesaurus_db_file);
                   3327:         return 0;
                   3328:     } 
                   3329:     #  Get the average number of appearances of a word.
                   3330:     my $avecount = $thesaurus_db{'average.count'};
                   3331:     #  Put keywords (those that appear > average) into %Keywords
                   3332:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3333:         my ($count,undef) = split /:/,$data;
                   3334:         $Keywords{$word}++ if ($count > $avecount);
                   3335:     }
                   3336:     untie %thesaurus_db;
                   3337:     # Remove special values from %Keywords.
1.356     albertel 3338:     foreach my $value ('total.count','average.count') {
                   3339:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3340:   }
1.46      matthew  3341:     return 1;
                   3342: }
                   3343: 
                   3344: ###################################################
                   3345: 
                   3346: =pod
                   3347: 
1.648     raeburn  3348: =item * &keyword($word)
1.46      matthew  3349: 
                   3350: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3351: than the average number of times in the thesaurus database.  Calls 
                   3352: &initialize_keywords
                   3353: 
                   3354: =cut
                   3355: 
                   3356: ###################################################
1.20      www      3357: 
                   3358: sub keyword {
1.46      matthew  3359:     return if (!&initialize_keywords());
                   3360:     my $word=lc(shift());
                   3361:     $word=~s/\W//g;
                   3362:     return exists($Keywords{$word});
1.20      www      3363: }
1.46      matthew  3364: 
                   3365: ###############################################################
                   3366: 
                   3367: =pod 
1.20      www      3368: 
1.648     raeburn  3369: =item * &get_related_words()
1.46      matthew  3370: 
1.160     matthew  3371: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3372: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3373: will be returned.  The order of the words returned is determined by the
                   3374: database which holds them.
                   3375: 
                   3376: Uses global $thesaurus_db_file.
                   3377: 
1.1057    foxr     3378: 
1.46      matthew  3379: =cut
                   3380: 
                   3381: ###############################################################
                   3382: sub get_related_words {
                   3383:     my $keyword = shift;
                   3384:     my %thesaurus_db;
                   3385:     if (! -e $thesaurus_db_file) {
                   3386:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3387:                                  "failed because the file does not exist");
                   3388:         return ();
                   3389:     }
                   3390:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3391:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3392:         return ();
                   3393:     } 
                   3394:     my @Words=();
1.429     www      3395:     my $count=0;
1.46      matthew  3396:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3397: 	# The first element is the number of times
                   3398: 	# the word appears.  We do not need it now.
1.429     www      3399: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3400: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3401: 	my $threshold=$mostfrequentcount/10;
                   3402:         foreach my $possibleword (@RelatedWords) {
                   3403:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3404:             if ($wordcount>$threshold) {
                   3405: 		push(@Words,$word);
                   3406:                 $count++;
                   3407:                 if ($count>10) { last; }
                   3408: 	    }
1.20      www      3409:         }
                   3410:     }
1.46      matthew  3411:     untie %thesaurus_db;
                   3412:     return @Words;
1.14      harris41 3413: }
1.46      matthew  3414: 
1.112     bowersj2 3415: =pod
                   3416: 
                   3417: =back
                   3418: 
                   3419: =cut
1.61      www      3420: 
                   3421: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3422: =pod
                   3423: 
1.112     bowersj2 3424: =head1 User Name Functions
                   3425: 
                   3426: =over 4
                   3427: 
1.648     raeburn  3428: =item * &plainname($uname,$udom,$first)
1.81      albertel 3429: 
1.112     bowersj2 3430: Takes a users logon name and returns it as a string in
1.226     albertel 3431: "first middle last generation" form 
                   3432: if $first is set to 'lastname' then it returns it as
                   3433: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3434: 
                   3435: =cut
1.61      www      3436: 
1.295     www      3437: 
1.81      albertel 3438: ###############################################################
1.61      www      3439: sub plainname {
1.226     albertel 3440:     my ($uname,$udom,$first)=@_;
1.537     albertel 3441:     return if (!defined($uname) || !defined($udom));
1.295     www      3442:     my %names=&getnames($uname,$udom);
1.226     albertel 3443:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3444: 					  $names{'middlename'},
                   3445: 					  $names{'lastname'},
                   3446: 					  $names{'generation'},$first);
                   3447:     $name=~s/^\s+//;
1.62      www      3448:     $name=~s/\s+$//;
                   3449:     $name=~s/\s+/ /g;
1.353     albertel 3450:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3451:     return $name;
1.61      www      3452: }
1.66      www      3453: 
                   3454: # -------------------------------------------------------------------- Nickname
1.81      albertel 3455: =pod
                   3456: 
1.648     raeburn  3457: =item * &nickname($uname,$udom)
1.81      albertel 3458: 
                   3459: Gets a users name and returns it as a string as
                   3460: 
                   3461: "&quot;nickname&quot;"
1.66      www      3462: 
1.81      albertel 3463: if the user has a nickname or
                   3464: 
                   3465: "first middle last generation"
                   3466: 
                   3467: if the user does not
                   3468: 
                   3469: =cut
1.66      www      3470: 
                   3471: sub nickname {
                   3472:     my ($uname,$udom)=@_;
1.537     albertel 3473:     return if (!defined($uname) || !defined($udom));
1.295     www      3474:     my %names=&getnames($uname,$udom);
1.68      albertel 3475:     my $name=$names{'nickname'};
1.66      www      3476:     if ($name) {
                   3477:        $name='&quot;'.$name.'&quot;'; 
                   3478:     } else {
                   3479:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3480: 	     $names{'lastname'}.' '.$names{'generation'};
                   3481:        $name=~s/\s+$//;
                   3482:        $name=~s/\s+/ /g;
                   3483:     }
                   3484:     return $name;
                   3485: }
                   3486: 
1.295     www      3487: sub getnames {
                   3488:     my ($uname,$udom)=@_;
1.537     albertel 3489:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3490:     if ($udom eq 'public' && $uname eq 'public') {
                   3491: 	return ('lastname' => &mt('Public'));
                   3492:     }
1.295     www      3493:     my $id=$uname.':'.$udom;
                   3494:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3495:     if ($cached) {
                   3496: 	return %{$names};
                   3497:     } else {
                   3498: 	my %loadnames=&Apache::lonnet::get('environment',
                   3499:                     ['firstname','middlename','lastname','generation','nickname'],
                   3500: 					 $udom,$uname);
                   3501: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3502: 	return %loadnames;
                   3503:     }
                   3504: }
1.61      www      3505: 
1.542     raeburn  3506: # -------------------------------------------------------------------- getemails
1.648     raeburn  3507: 
1.542     raeburn  3508: =pod
                   3509: 
1.648     raeburn  3510: =item * &getemails($uname,$udom)
1.542     raeburn  3511: 
                   3512: Gets a user's email information and returns it as a hash with keys:
                   3513: notification, critnotification, permanentemail
                   3514: 
                   3515: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3516: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3517:  
1.648     raeburn  3518: 
1.542     raeburn  3519: =cut
                   3520: 
1.648     raeburn  3521: 
1.466     albertel 3522: sub getemails {
                   3523:     my ($uname,$udom)=@_;
                   3524:     if ($udom eq 'public' && $uname eq 'public') {
                   3525: 	return;
                   3526:     }
1.467     www      3527:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3528:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3529:     my $id=$uname.':'.$udom;
                   3530:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3531:     if ($cached) {
                   3532: 	return %{$names};
                   3533:     } else {
                   3534: 	my %loadnames=&Apache::lonnet::get('environment',
                   3535:                     			   ['notification','critnotification',
                   3536: 					    'permanentemail'],
                   3537: 					   $udom,$uname);
                   3538: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3539: 	return %loadnames;
                   3540:     }
                   3541: }
                   3542: 
1.551     albertel 3543: sub flush_email_cache {
                   3544:     my ($uname,$udom)=@_;
                   3545:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3546:     if (!$uname) { $uname=$env{'user.name'};   }
                   3547:     return if ($udom eq 'public' && $uname eq 'public');
                   3548:     my $id=$uname.':'.$udom;
                   3549:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3550: }
                   3551: 
1.728     raeburn  3552: # -------------------------------------------------------------------- getlangs
                   3553: 
                   3554: =pod
                   3555: 
                   3556: =item * &getlangs($uname,$udom)
                   3557: 
                   3558: Gets a user's language preference and returns it as a hash with key:
                   3559: language.
                   3560: 
                   3561: =cut
                   3562: 
                   3563: 
                   3564: sub getlangs {
                   3565:     my ($uname,$udom) = @_;
                   3566:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3567:     if (!$uname) { $uname=$env{'user.name'};   }
                   3568:     my $id=$uname.':'.$udom;
                   3569:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3570:     if ($cached) {
                   3571:         return %{$langs};
                   3572:     } else {
                   3573:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3574:                                            $udom,$uname);
                   3575:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3576:         return %loadlangs;
                   3577:     }
                   3578: }
                   3579: 
                   3580: sub flush_langs_cache {
                   3581:     my ($uname,$udom)=@_;
                   3582:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3583:     if (!$uname) { $uname=$env{'user.name'};   }
                   3584:     return if ($udom eq 'public' && $uname eq 'public');
                   3585:     my $id=$uname.':'.$udom;
                   3586:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3587: }
                   3588: 
1.61      www      3589: # ------------------------------------------------------------------ Screenname
1.81      albertel 3590: 
                   3591: =pod
                   3592: 
1.648     raeburn  3593: =item * &screenname($uname,$udom)
1.81      albertel 3594: 
                   3595: Gets a users screenname and returns it as a string
                   3596: 
                   3597: =cut
1.61      www      3598: 
                   3599: sub screenname {
                   3600:     my ($uname,$udom)=@_;
1.258     albertel 3601:     if ($uname eq $env{'user.name'} &&
                   3602: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3603:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3604:     return $names{'screenname'};
1.62      www      3605: }
                   3606: 
1.212     albertel 3607: 
1.802     bisitz   3608: # ------------------------------------------------------------- Confirm Wrapper
                   3609: =pod
                   3610: 
1.1075.2.42  raeburn  3611: =item * &confirmwrapper($message)
1.802     bisitz   3612: 
                   3613: Wrap messages about completion of operation in box
                   3614: 
                   3615: =cut
                   3616: 
                   3617: sub confirmwrapper {
                   3618:     my ($message)=@_;
                   3619:     if ($message) {
                   3620:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3621:                .$message."\n"
                   3622:                .'</div>'."\n";
                   3623:     } else {
                   3624:         return $message;
                   3625:     }
                   3626: }
                   3627: 
1.62      www      3628: # ------------------------------------------------------------- Message Wrapper
                   3629: 
                   3630: sub messagewrapper {
1.369     www      3631:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3632:     return 
1.441     albertel 3633:         '<a href="/adm/email?compose=individual&amp;'.
                   3634:         'recname='.$username.'&amp;recdom='.$domain.
                   3635: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3636:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3637: }
1.802     bisitz   3638: 
1.74      www      3639: # --------------------------------------------------------------- Notes Wrapper
                   3640: 
                   3641: sub noteswrapper {
                   3642:     my ($link,$un,$do)=@_;
                   3643:     return 
1.896     amueller 3644: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3645: }
1.802     bisitz   3646: 
1.62      www      3647: # ------------------------------------------------------------- Aboutme Wrapper
                   3648: 
                   3649: sub aboutmewrapper {
1.1070    raeburn  3650:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3651:     if (!defined($username)  && !defined($domain)) {
                   3652:         return;
                   3653:     }
1.1075.2.15  raeburn  3654:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3655: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3656: }
                   3657: 
                   3658: # ------------------------------------------------------------ Syllabus Wrapper
                   3659: 
                   3660: sub syllabuswrapper {
1.707     bisitz   3661:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3662:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3663: }
1.14      harris41 3664: 
1.802     bisitz   3665: # -----------------------------------------------------------------------------
                   3666: 
1.208     matthew  3667: sub track_student_link {
1.887     raeburn  3668:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3669:     my $link ="/adm/trackstudent?";
1.208     matthew  3670:     my $title = 'View recent activity';
                   3671:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3672:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3673:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3674:         $title .= ' of this student';
1.268     albertel 3675:     } 
1.208     matthew  3676:     if (defined($target) && $target !~ /^\s*$/) {
                   3677:         $target = qq{target="$target"};
                   3678:     } else {
                   3679:         $target = '';
                   3680:     }
1.268     albertel 3681:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3682:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3683:     $title = &mt($title);
                   3684:     $linktext = &mt($linktext);
1.448     albertel 3685:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3686: 	&help_open_topic('View_recent_activity');
1.208     matthew  3687: }
                   3688: 
1.781     raeburn  3689: sub slot_reservations_link {
                   3690:     my ($linktext,$sname,$sdom,$target) = @_;
                   3691:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3692:     my $title = 'View slot reservation history';
                   3693:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3694:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3695:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3696:         $title .= ' of this student';
                   3697:     }
                   3698:     if (defined($target) && $target !~ /^\s*$/) {
                   3699:         $target = qq{target="$target"};
                   3700:     } else {
                   3701:         $target = '';
                   3702:     }
                   3703:     $title = &mt($title);
                   3704:     $linktext = &mt($linktext);
                   3705:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3706: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3707: 
                   3708: }
                   3709: 
1.508     www      3710: # ===================================================== Display a student photo
                   3711: 
                   3712: 
1.509     albertel 3713: sub student_image_tag {
1.508     www      3714:     my ($domain,$user)=@_;
                   3715:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3716:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3717: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3718:     } else {
                   3719: 	return '';
                   3720:     }
                   3721: }
                   3722: 
1.112     bowersj2 3723: =pod
                   3724: 
                   3725: =back
                   3726: 
                   3727: =head1 Access .tab File Data
                   3728: 
                   3729: =over 4
                   3730: 
1.648     raeburn  3731: =item * &languageids() 
1.112     bowersj2 3732: 
                   3733: returns list of all language ids
                   3734: 
                   3735: =cut
                   3736: 
1.14      harris41 3737: sub languageids {
1.16      harris41 3738:     return sort(keys(%language));
1.14      harris41 3739: }
                   3740: 
1.112     bowersj2 3741: =pod
                   3742: 
1.648     raeburn  3743: =item * &languagedescription() 
1.112     bowersj2 3744: 
                   3745: returns description of a specified language id
                   3746: 
                   3747: =cut
                   3748: 
1.14      harris41 3749: sub languagedescription {
1.125     www      3750:     my $code=shift;
                   3751:     return  ($supported_language{$code}?'* ':'').
                   3752:             $language{$code}.
1.126     www      3753: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3754: }
                   3755: 
1.1048    foxr     3756: =pod
                   3757: 
                   3758: =item * &plainlanguagedescription
                   3759: 
                   3760: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3761: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3762: 
                   3763: =cut
                   3764: 
1.145     www      3765: sub plainlanguagedescription {
                   3766:     my $code=shift;
                   3767:     return $language{$code};
                   3768: }
                   3769: 
1.1048    foxr     3770: =pod
                   3771: 
                   3772: =item * &supportedlanguagecode
                   3773: 
                   3774: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3775: code.
                   3776: 
                   3777: =cut
                   3778: 
1.145     www      3779: sub supportedlanguagecode {
                   3780:     my $code=shift;
                   3781:     return $supported_language{$code};
1.97      www      3782: }
                   3783: 
1.112     bowersj2 3784: =pod
                   3785: 
1.1048    foxr     3786: =item * &latexlanguage()
                   3787: 
                   3788: Given a language key code returns the correspondnig language to use
                   3789: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3790: is no supported hyphenation for the language code.
                   3791: 
                   3792: =cut
                   3793: 
                   3794: sub latexlanguage {
                   3795:     my $code = shift;
                   3796:     return $latex_language{$code};
                   3797: }
                   3798: 
                   3799: =pod
                   3800: 
                   3801: =item * &latexhyphenation()
                   3802: 
                   3803: Same as above but what's supplied is the language as it might be stored
                   3804: in the metadata.
                   3805: 
                   3806: =cut
                   3807: 
                   3808: sub latexhyphenation {
                   3809:     my $key = shift;
                   3810:     return $latex_language_bykey{$key};
                   3811: }
                   3812: 
                   3813: =pod
                   3814: 
1.648     raeburn  3815: =item * &copyrightids() 
1.112     bowersj2 3816: 
                   3817: returns list of all copyrights
                   3818: 
                   3819: =cut
                   3820: 
                   3821: sub copyrightids {
                   3822:     return sort(keys(%cprtag));
                   3823: }
                   3824: 
                   3825: =pod
                   3826: 
1.648     raeburn  3827: =item * &copyrightdescription() 
1.112     bowersj2 3828: 
                   3829: returns description of a specified copyright id
                   3830: 
                   3831: =cut
                   3832: 
                   3833: sub copyrightdescription {
1.166     www      3834:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3835: }
1.197     matthew  3836: 
                   3837: =pod
                   3838: 
1.648     raeburn  3839: =item * &source_copyrightids() 
1.192     taceyjo1 3840: 
                   3841: returns list of all source copyrights
                   3842: 
                   3843: =cut
                   3844: 
                   3845: sub source_copyrightids {
                   3846:     return sort(keys(%scprtag));
                   3847: }
                   3848: 
                   3849: =pod
                   3850: 
1.648     raeburn  3851: =item * &source_copyrightdescription() 
1.192     taceyjo1 3852: 
                   3853: returns description of a specified source copyright id
                   3854: 
                   3855: =cut
                   3856: 
                   3857: sub source_copyrightdescription {
                   3858:     return &mt($scprtag{shift(@_)});
                   3859: }
1.112     bowersj2 3860: 
                   3861: =pod
                   3862: 
1.648     raeburn  3863: =item * &filecategories() 
1.112     bowersj2 3864: 
                   3865: returns list of all file categories
                   3866: 
                   3867: =cut
                   3868: 
                   3869: sub filecategories {
                   3870:     return sort(keys(%category_extensions));
                   3871: }
                   3872: 
                   3873: =pod
                   3874: 
1.648     raeburn  3875: =item * &filecategorytypes() 
1.112     bowersj2 3876: 
                   3877: returns list of file types belonging to a given file
                   3878: category
                   3879: 
                   3880: =cut
                   3881: 
                   3882: sub filecategorytypes {
1.356     albertel 3883:     my ($cat) = @_;
                   3884:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3885: }
                   3886: 
                   3887: =pod
                   3888: 
1.648     raeburn  3889: =item * &fileembstyle() 
1.112     bowersj2 3890: 
                   3891: returns embedding style for a specified file type
                   3892: 
                   3893: =cut
                   3894: 
                   3895: sub fileembstyle {
                   3896:     return $fe{lc(shift(@_))};
1.169     www      3897: }
                   3898: 
1.351     www      3899: sub filemimetype {
                   3900:     return $fm{lc(shift(@_))};
                   3901: }
                   3902: 
1.169     www      3903: 
                   3904: sub filecategoryselect {
                   3905:     my ($name,$value)=@_;
1.189     matthew  3906:     return &select_form($value,$name,
1.970     raeburn  3907:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3908: }
                   3909: 
                   3910: =pod
                   3911: 
1.648     raeburn  3912: =item * &filedescription() 
1.112     bowersj2 3913: 
                   3914: returns description for a specified file type
                   3915: 
                   3916: =cut
                   3917: 
                   3918: sub filedescription {
1.188     matthew  3919:     my $file_description = $fd{lc(shift())};
                   3920:     $file_description =~ s:([\[\]]):~$1:g;
                   3921:     return &mt($file_description);
1.112     bowersj2 3922: }
                   3923: 
                   3924: =pod
                   3925: 
1.648     raeburn  3926: =item * &filedescriptionex() 
1.112     bowersj2 3927: 
                   3928: returns description for a specified file type with
                   3929: extra formatting
                   3930: 
                   3931: =cut
                   3932: 
                   3933: sub filedescriptionex {
                   3934:     my $ex=shift;
1.188     matthew  3935:     my $file_description = $fd{lc($ex)};
                   3936:     $file_description =~ s:([\[\]]):~$1:g;
                   3937:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3938: }
                   3939: 
                   3940: # End of .tab access
                   3941: =pod
                   3942: 
                   3943: =back
                   3944: 
                   3945: =cut
                   3946: 
                   3947: # ------------------------------------------------------------------ File Types
                   3948: sub fileextensions {
                   3949:     return sort(keys(%fe));
                   3950: }
                   3951: 
1.97      www      3952: # ----------------------------------------------------------- Display Languages
                   3953: # returns a hash with all desired display languages
                   3954: #
                   3955: 
                   3956: sub display_languages {
                   3957:     my %languages=();
1.695     raeburn  3958:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3959: 	$languages{$lang}=1;
1.97      www      3960:     }
                   3961:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3962:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3963: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3964: 	    $languages{$lang}=1;
1.97      www      3965:         }
                   3966:     }
                   3967:     return %languages;
1.14      harris41 3968: }
                   3969: 
1.582     albertel 3970: sub languages {
                   3971:     my ($possible_langs) = @_;
1.695     raeburn  3972:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3973:     if (!ref($possible_langs)) {
                   3974: 	if( wantarray ) {
                   3975: 	    return @preferred_langs;
                   3976: 	} else {
                   3977: 	    return $preferred_langs[0];
                   3978: 	}
                   3979:     }
                   3980:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3981:     my @preferred_possibilities;
                   3982:     foreach my $preferred_lang (@preferred_langs) {
                   3983: 	if (exists($possibilities{$preferred_lang})) {
                   3984: 	    push(@preferred_possibilities, $preferred_lang);
                   3985: 	}
                   3986:     }
                   3987:     if( wantarray ) {
                   3988: 	return @preferred_possibilities;
                   3989:     }
                   3990:     return $preferred_possibilities[0];
                   3991: }
                   3992: 
1.742     raeburn  3993: sub user_lang {
                   3994:     my ($touname,$toudom,$fromcid) = @_;
                   3995:     my @userlangs;
                   3996:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3997:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3998:                     $env{'course.'.$fromcid.'.languages'}));
                   3999:     } else {
                   4000:         my %langhash = &getlangs($touname,$toudom);
                   4001:         if ($langhash{'languages'} ne '') {
                   4002:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   4003:         } else {
                   4004:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   4005:             if ($domdefs{'lang_def'} ne '') {
                   4006:                 @userlangs = ($domdefs{'lang_def'});
                   4007:             }
                   4008:         }
                   4009:     }
                   4010:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4011:     my $user_lh = Apache::localize->get_handle(@languages);
                   4012:     return $user_lh;
                   4013: }
                   4014: 
                   4015: 
1.112     bowersj2 4016: ###############################################################
                   4017: ##               Student Answer Attempts                     ##
                   4018: ###############################################################
                   4019: 
                   4020: =pod
                   4021: 
                   4022: =head1 Alternate Problem Views
                   4023: 
                   4024: =over 4
                   4025: 
1.648     raeburn  4026: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86  raeburn  4027:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4028: 
                   4029: Return string with previous attempt on problem. Arguments:
                   4030: 
                   4031: =over 4
                   4032: 
                   4033: =item * $symb: Problem, including path
                   4034: 
                   4035: =item * $username: username of the desired student
                   4036: 
                   4037: =item * $domain: domain of the desired student
1.14      harris41 4038: 
1.112     bowersj2 4039: =item * $course: Course ID
1.14      harris41 4040: 
1.112     bowersj2 4041: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4042:     something
1.14      harris41 4043: 
1.112     bowersj2 4044: =item * $regexp: if string matches this regexp, the string will be
                   4045:     sent to $gradesub
1.14      harris41 4046: 
1.112     bowersj2 4047: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4048: 
1.1075.2.86  raeburn  4049: =item * $usec: section of the desired student
                   4050: 
                   4051: =item * $identifier: counter for student (multiple students one problem) or
                   4052:     problem (one student; whole sequence).
                   4053: 
1.112     bowersj2 4054: =back
1.14      harris41 4055: 
1.112     bowersj2 4056: The output string is a table containing all desired attempts, if any.
1.16      harris41 4057: 
1.112     bowersj2 4058: =cut
1.1       albertel 4059: 
                   4060: sub get_previous_attempt {
1.1075.2.86  raeburn  4061:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4062:   my $prevattempts='';
1.43      ng       4063:   no strict 'refs';
1.1       albertel 4064:   if ($symb) {
1.3       albertel 4065:     my (%returnhash)=
                   4066:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4067:     if ($returnhash{'version'}) {
                   4068:       my %lasthash=();
                   4069:       my $version;
                   4070:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91  raeburn  4071:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4072:             if ($key =~ /\.rawrndseed$/) {
                   4073:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4074:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4075:             } else {
                   4076:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4077:             }
1.19      harris41 4078:         }
1.1       albertel 4079:       }
1.596     albertel 4080:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4081:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86  raeburn  4082:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4083:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4084:       foreach my $key (sort(keys(%lasthash))) {
                   4085: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4086: 	if ($#parts > 0) {
1.31      albertel 4087: 	  my $data=$parts[-1];
1.989     raeburn  4088:           next if ($data eq 'foilorder');
1.31      albertel 4089: 	  pop(@parts);
1.1010    www      4090:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4091:           if ($data eq 'type') {
                   4092:               unless ($showsurv) {
                   4093:                   my $id = join(',',@parts);
                   4094:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4095:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4096:                       $lasthidden{$ign.'.'.$id} = 1;
                   4097:                   }
1.945     raeburn  4098:               }
1.1075.2.86  raeburn  4099:               if ($identifier ne '') {
                   4100:                   my $id = join(',',@parts);
                   4101:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4102:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4103:                       $hidestatus{$ign.'.'.$id} = 1;
                   4104:                   }
                   4105:               }
                   4106:           } elsif ($data eq 'regrader') {
                   4107:               if (($identifier ne '') && (@parts)) {
                   4108:                   my $id = join(',',@parts);
                   4109:                   $regraded{$ign.'.'.$id} = 1;
                   4110:               }
1.1010    www      4111:           } 
1.31      albertel 4112: 	} else {
1.41      ng       4113: 	  if ($#parts == 0) {
                   4114: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4115: 	  } else {
                   4116: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4117: 	  }
1.31      albertel 4118: 	}
1.16      harris41 4119:       }
1.596     albertel 4120:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4121:       if ($getattempt eq '') {
1.1075.2.86  raeburn  4122:         my (%solved,%resets,%probstatus);
                   4123:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4124:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4125:                 foreach my $id (keys(%regraded)) {
                   4126:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4127:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4128:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4129:                         push(@{$resets{$id}},$version);
                   4130:                     }
                   4131:                 }
                   4132:             }
                   4133:         }
1.40      ng       4134: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86  raeburn  4135:             my (@hidden,@unsolved);
1.945     raeburn  4136:             if (%typeparts) {
                   4137:                 foreach my $id (keys(%typeparts)) {
1.1075.2.86  raeburn  4138:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
                   4139:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4140:                         push(@hidden,$id);
1.1075.2.86  raeburn  4141:                     } elsif ($identifier ne '') {
                   4142:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4143:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4144:                                 ($hidestatus{$id})) {
                   4145:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
                   4146:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4147:                                 push(@{$solved{$id}},$version);
                   4148:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4149:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4150:                                 my $skip;
                   4151:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4152:                                     foreach my $reset (@{$resets{$id}}) {
                   4153:                                         if ($reset > $solved{$id}[-1]) {
                   4154:                                             $skip=1;
                   4155:                                             last;
                   4156:                                         }
                   4157:                                     }
                   4158:                                 }
                   4159:                                 unless ($skip) {
                   4160:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4161:                                     push(@unsolved,$partslist);
                   4162:                                 }
                   4163:                             }
                   4164:                         }
1.945     raeburn  4165:                     }
                   4166:                 }
                   4167:             }
                   4168:             $prevattempts.=&start_data_table_row().
1.1075.2.86  raeburn  4169:                            '<td>'.&mt('Transaction [_1]',$version);
                   4170:             if (@unsolved) {
                   4171:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4172:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4173:                                  &mt('Hide').'</label></span>';
                   4174:             }
                   4175:             $prevattempts .= '</td>';
1.945     raeburn  4176:             if (@hidden) {
                   4177:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4178:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4179:                     my $hide;
                   4180:                     foreach my $id (@hidden) {
                   4181:                         if ($key =~ /^\Q$id\E/) {
                   4182:                             $hide = 1;
                   4183:                             last;
                   4184:                         }
                   4185:                     }
                   4186:                     if ($hide) {
                   4187:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4188:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4189:                             my $value = &format_previous_attempt_value($key,
                   4190:                                              $returnhash{$version.':'.$key});
                   4191:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4192:                         } else {
                   4193:                             $prevattempts.='<td>&nbsp;</td>';
                   4194:                         }
                   4195:                     } else {
                   4196:                         if ($key =~ /\./) {
1.1075.2.91  raeburn  4197:                             my $value = $returnhash{$version.':'.$key};
                   4198:                             if ($key =~ /\.rndseed$/) {
                   4199:                                 my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   4200:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4201:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4202:                                 }
                   4203:                             }
                   4204:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4205:                                            '&nbsp;</td>';
1.945     raeburn  4206:                         } else {
                   4207:                             $prevattempts.='<td>&nbsp;</td>';
                   4208:                         }
                   4209:                     }
                   4210:                 }
                   4211:             } else {
                   4212: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4213:                     next if ($key =~ /\.foilorder$/);
1.1075.2.91  raeburn  4214:                     my $value = $returnhash{$version.':'.$key};
                   4215:                     if ($key =~ /\.rndseed$/) {
                   4216:                         my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   4217:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4218:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4219:                         }
                   4220:                     }
                   4221:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4222:                                    '&nbsp;</td>';
1.945     raeburn  4223: 	        }
                   4224:             }
                   4225: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4226: 	 }
1.1       albertel 4227:       }
1.945     raeburn  4228:       my @currhidden = keys(%lasthidden);
1.596     albertel 4229:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4230:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4231:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4232:           if (%typeparts) {
                   4233:               my $hidden;
                   4234:               foreach my $id (@currhidden) {
                   4235:                   if ($key =~ /^\Q$id\E/) {
                   4236:                       $hidden = 1;
                   4237:                       last;
                   4238:                   }
                   4239:               }
                   4240:               if ($hidden) {
                   4241:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4242:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4243:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4244:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4245:                           $value = &$gradesub($value);
                   4246:                       }
                   4247:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4248:                   } else {
                   4249:                       $prevattempts.='<td>&nbsp;</td>';
                   4250:                   }
                   4251:               } else {
                   4252:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4253:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4254:                       $value = &$gradesub($value);
                   4255:                   }
                   4256:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4257:               }
                   4258:           } else {
                   4259: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4260: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4261:                   $value = &$gradesub($value);
                   4262:               }
                   4263: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4264:           }
1.16      harris41 4265:       }
1.596     albertel 4266:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4267:     } else {
1.596     albertel 4268:       $prevattempts=
                   4269: 	  &start_data_table().&start_data_table_row().
                   4270: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   4271: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4272:     }
                   4273:   } else {
1.596     albertel 4274:     $prevattempts=
                   4275: 	  &start_data_table().&start_data_table_row().
                   4276: 	  '<td>'.&mt('No data.').'</td>'.
                   4277: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4278:   }
1.10      albertel 4279: }
                   4280: 
1.581     albertel 4281: sub format_previous_attempt_value {
                   4282:     my ($key,$value) = @_;
1.1011    www      4283:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 4284: 	$value = &Apache::lonlocal::locallocaltime($value);
                   4285:     } elsif (ref($value) eq 'ARRAY') {
                   4286: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  4287:     } elsif ($key =~ /answerstring$/) {
                   4288:         my %answers = &Apache::lonnet::str2hash($value);
                   4289:         my @anskeys = sort(keys(%answers));
                   4290:         if (@anskeys == 1) {
                   4291:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4292:             if ($answer =~ m{\0}) {
                   4293:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4294:             }
                   4295:             my $tag_internal_answer_name = 'INTERNAL';
                   4296:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4297:                 $value = $answer; 
                   4298:             } else {
                   4299:                 $value = $anskeys[0].'='.$answer;
                   4300:             }
                   4301:         } else {
                   4302:             foreach my $ans (@anskeys) {
                   4303:                 my $answer = $answers{$ans};
1.1001    raeburn  4304:                 if ($answer =~ m{\0}) {
                   4305:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4306:                 }
                   4307:                 $value .=  $ans.'='.$answer.'<br />';;
                   4308:             } 
                   4309:         }
1.581     albertel 4310:     } else {
                   4311: 	$value = &unescape($value);
                   4312:     }
                   4313:     return $value;
                   4314: }
                   4315: 
                   4316: 
1.107     albertel 4317: sub relative_to_absolute {
                   4318:     my ($url,$output)=@_;
                   4319:     my $parser=HTML::TokeParser->new(\$output);
                   4320:     my $token;
                   4321:     my $thisdir=$url;
                   4322:     my @rlinks=();
                   4323:     while ($token=$parser->get_token) {
                   4324: 	if ($token->[0] eq 'S') {
                   4325: 	    if ($token->[1] eq 'a') {
                   4326: 		if ($token->[2]->{'href'}) {
                   4327: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4328: 		}
                   4329: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4330: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4331: 	    } elsif ($token->[1] eq 'base') {
                   4332: 		$thisdir=$token->[2]->{'href'};
                   4333: 	    }
                   4334: 	}
                   4335:     }
                   4336:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4337:     foreach my $link (@rlinks) {
1.726     raeburn  4338: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4339: 		($link=~/^\//) ||
                   4340: 		($link=~/^javascript:/i) ||
                   4341: 		($link=~/^mailto:/i) ||
                   4342: 		($link=~/^\#/)) {
                   4343: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4344: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4345: 	}
                   4346:     }
                   4347: # -------------------------------------------------- Deal with Applet codebases
                   4348:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4349:     return $output;
                   4350: }
                   4351: 
1.112     bowersj2 4352: =pod
                   4353: 
1.648     raeburn  4354: =item * &get_student_view()
1.112     bowersj2 4355: 
                   4356: show a snapshot of what student was looking at
                   4357: 
                   4358: =cut
                   4359: 
1.10      albertel 4360: sub get_student_view {
1.186     albertel 4361:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4362:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4363:   my (%form);
1.10      albertel 4364:   my @elements=('symb','courseid','domain','username');
                   4365:   foreach my $element (@elements) {
1.186     albertel 4366:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4367:   }
1.186     albertel 4368:   if (defined($moreenv)) {
                   4369:       %form=(%form,%{$moreenv});
                   4370:   }
1.236     albertel 4371:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4372:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4373:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4374:   $userview=~s/\<body[^\>]*\>//gi;
                   4375:   $userview=~s/\<\/body\>//gi;
                   4376:   $userview=~s/\<html\>//gi;
                   4377:   $userview=~s/\<\/html\>//gi;
                   4378:   $userview=~s/\<head\>//gi;
                   4379:   $userview=~s/\<\/head\>//gi;
                   4380:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4381:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4382:   if (wantarray) {
                   4383:      return ($userview,$response);
                   4384:   } else {
                   4385:      return $userview;
                   4386:   }
                   4387: }
                   4388: 
                   4389: sub get_student_view_with_retries {
                   4390:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4391: 
                   4392:     my $ok = 0;                 # True if we got a good response.
                   4393:     my $content;
                   4394:     my $response;
                   4395: 
                   4396:     # Try to get the student_view done. within the retries count:
                   4397:     
                   4398:     do {
                   4399:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4400:          $ok      = $response->is_success;
                   4401:          if (!$ok) {
                   4402:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4403:          }
                   4404:          $retries--;
                   4405:     } while (!$ok && ($retries > 0));
                   4406:     
                   4407:     if (!$ok) {
                   4408:        $content = '';          # On error return an empty content.
                   4409:     }
1.651     www      4410:     if (wantarray) {
                   4411:        return ($content, $response);
                   4412:     } else {
                   4413:        return $content;
                   4414:     }
1.11      albertel 4415: }
                   4416: 
1.112     bowersj2 4417: =pod
                   4418: 
1.648     raeburn  4419: =item * &get_student_answers() 
1.112     bowersj2 4420: 
                   4421: show a snapshot of how student was answering problem
                   4422: 
                   4423: =cut
                   4424: 
1.11      albertel 4425: sub get_student_answers {
1.100     sakharuk 4426:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4427:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4428:   my (%moreenv);
1.11      albertel 4429:   my @elements=('symb','courseid','domain','username');
                   4430:   foreach my $element (@elements) {
1.186     albertel 4431:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4432:   }
1.186     albertel 4433:   $moreenv{'grade_target'}='answer';
                   4434:   %moreenv=(%form,%moreenv);
1.497     raeburn  4435:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4436:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4437:   return $userview;
1.1       albertel 4438: }
1.116     albertel 4439: 
                   4440: =pod
                   4441: 
                   4442: =item * &submlink()
                   4443: 
1.242     albertel 4444: Inputs: $text $uname $udom $symb $target
1.116     albertel 4445: 
                   4446: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4447: 
                   4448: =cut
                   4449: 
                   4450: ###############################################
                   4451: sub submlink {
1.242     albertel 4452:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4453:     if (!($uname && $udom)) {
                   4454: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4455: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4456: 	if (!$symb) { $symb=$cursymb; }
                   4457:     }
1.254     matthew  4458:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4459:     $symb=&escape($symb);
1.960     bisitz   4460:     if ($target) { $target=" target=\"$target\""; }
                   4461:     return
                   4462:         '<a href="/adm/grades?command=submission'.
                   4463:         '&amp;symb='.$symb.
                   4464:         '&amp;student='.$uname.
                   4465:         '&amp;userdom='.$udom.'"'.
                   4466:         $target.'>'.$text.'</a>';
1.242     albertel 4467: }
                   4468: ##############################################
                   4469: 
                   4470: =pod
                   4471: 
                   4472: =item * &pgrdlink()
                   4473: 
                   4474: Inputs: $text $uname $udom $symb $target
                   4475: 
                   4476: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4477: 
                   4478: =cut
                   4479: 
                   4480: ###############################################
                   4481: sub pgrdlink {
                   4482:     my $link=&submlink(@_);
                   4483:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4484:     return $link;
                   4485: }
                   4486: ##############################################
                   4487: 
                   4488: =pod
                   4489: 
                   4490: =item * &pprmlink()
                   4491: 
                   4492: Inputs: $text $uname $udom $symb $target
                   4493: 
                   4494: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4495: student and a specific resource
1.242     albertel 4496: 
                   4497: =cut
                   4498: 
                   4499: ###############################################
                   4500: sub pprmlink {
                   4501:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4502:     if (!($uname && $udom)) {
                   4503: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4504: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4505: 	if (!$symb) { $symb=$cursymb; }
                   4506:     }
1.254     matthew  4507:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4508:     $symb=&escape($symb);
1.242     albertel 4509:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4510:     return '<a href="/adm/parmset?command=set&amp;'.
                   4511: 	'symb='.$symb.'&amp;uname='.$uname.
                   4512: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4513: }
                   4514: ##############################################
1.37      matthew  4515: 
1.112     bowersj2 4516: =pod
                   4517: 
                   4518: =back
                   4519: 
                   4520: =cut
                   4521: 
1.37      matthew  4522: ###############################################
1.51      www      4523: 
                   4524: 
                   4525: sub timehash {
1.687     raeburn  4526:     my ($thistime) = @_;
                   4527:     my $timezone = &Apache::lonlocal::gettimezone();
                   4528:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4529:                      ->set_time_zone($timezone);
                   4530:     my $wday = $dt->day_of_week();
                   4531:     if ($wday == 7) { $wday = 0; }
                   4532:     return ( 'second' => $dt->second(),
                   4533:              'minute' => $dt->minute(),
                   4534:              'hour'   => $dt->hour(),
                   4535:              'day'     => $dt->day_of_month(),
                   4536:              'month'   => $dt->month(),
                   4537:              'year'    => $dt->year(),
                   4538:              'weekday' => $wday,
                   4539:              'dayyear' => $dt->day_of_year(),
                   4540:              'dlsav'   => $dt->is_dst() );
1.51      www      4541: }
                   4542: 
1.370     www      4543: sub utc_string {
                   4544:     my ($date)=@_;
1.371     www      4545:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4546: }
                   4547: 
1.51      www      4548: sub maketime {
                   4549:     my %th=@_;
1.687     raeburn  4550:     my ($epoch_time,$timezone,$dt);
                   4551:     $timezone = &Apache::lonlocal::gettimezone();
                   4552:     eval {
                   4553:         $dt = DateTime->new( year   => $th{'year'},
                   4554:                              month  => $th{'month'},
                   4555:                              day    => $th{'day'},
                   4556:                              hour   => $th{'hour'},
                   4557:                              minute => $th{'minute'},
                   4558:                              second => $th{'second'},
                   4559:                              time_zone => $timezone,
                   4560:                          );
                   4561:     };
                   4562:     if (!$@) {
                   4563:         $epoch_time = $dt->epoch;
                   4564:         if ($epoch_time) {
                   4565:             return $epoch_time;
                   4566:         }
                   4567:     }
1.51      www      4568:     return POSIX::mktime(
                   4569:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4570:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4571: }
                   4572: 
                   4573: #########################################
1.51      www      4574: 
                   4575: sub findallcourses {
1.482     raeburn  4576:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4577:     my %roles;
                   4578:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4579:     my %courses;
1.51      www      4580:     my $now=time;
1.482     raeburn  4581:     if (!defined($uname)) {
                   4582:         $uname = $env{'user.name'};
                   4583:     }
                   4584:     if (!defined($udom)) {
                   4585:         $udom = $env{'user.domain'};
                   4586:     }
                   4587:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4588:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4589:         if (!%roles) {
                   4590:             %roles = (
                   4591:                        cc => 1,
1.907     raeburn  4592:                        co => 1,
1.482     raeburn  4593:                        in => 1,
                   4594:                        ep => 1,
                   4595:                        ta => 1,
                   4596:                        cr => 1,
                   4597:                        st => 1,
                   4598:              );
                   4599:         }
                   4600:         foreach my $entry (keys(%roleshash)) {
                   4601:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4602:             if ($trole =~ /^cr/) { 
                   4603:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4604:             } else {
                   4605:                 next if (!exists($roles{$trole}));
                   4606:             }
                   4607:             if ($tend) {
                   4608:                 next if ($tend < $now);
                   4609:             }
                   4610:             if ($tstart) {
                   4611:                 next if ($tstart > $now);
                   4612:             }
1.1058    raeburn  4613:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4614:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4615:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4616:             if ($secpart eq '') {
                   4617:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4618:                 $sec = 'none';
1.1058    raeburn  4619:                 $value .= $cnum.'/';
1.482     raeburn  4620:             } else {
                   4621:                 $cnum = $cnumpart;
                   4622:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4623:                 $value .= $cnum.'/'.$sec;
                   4624:             }
                   4625:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4626:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4627:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4628:                 }
                   4629:             } else {
                   4630:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4631:             }
1.482     raeburn  4632:         }
                   4633:     } else {
                   4634:         foreach my $key (keys(%env)) {
1.483     albertel 4635: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4636:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4637: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4638: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4639: 	        next if (%roles && !exists($roles{$role}));
                   4640: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4641:                 my $active=1;
                   4642:                 if ($starttime) {
                   4643: 		    if ($now<$starttime) { $active=0; }
                   4644:                 }
                   4645:                 if ($endtime) {
                   4646:                     if ($now>$endtime) { $active=0; }
                   4647:                 }
                   4648:                 if ($active) {
1.1058    raeburn  4649:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4650:                     if ($sec eq '') {
                   4651:                         $sec = 'none';
1.1058    raeburn  4652:                     } else {
                   4653:                         $value .= $sec;
                   4654:                     }
                   4655:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4656:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4657:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4658:                         }
                   4659:                     } else {
                   4660:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4661:                     }
1.474     raeburn  4662:                 }
                   4663:             }
1.51      www      4664:         }
                   4665:     }
1.474     raeburn  4666:     return %courses;
1.51      www      4667: }
1.37      matthew  4668: 
1.54      www      4669: ###############################################
1.474     raeburn  4670: 
                   4671: sub blockcheck {
1.1075.2.73  raeburn  4672:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4673: 
1.1075.2.73  raeburn  4674:     if (defined($udom) && defined($uname)) {
                   4675:         # If uname and udom are for a course, check for blocks in the course.
                   4676:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4677:             my ($startblock,$endblock,$triggerblock) =
                   4678:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4679:             return ($startblock,$endblock,$triggerblock);
                   4680:         }
                   4681:     } else {
1.490     raeburn  4682:         $udom = $env{'user.domain'};
                   4683:         $uname = $env{'user.name'};
                   4684:     }
                   4685: 
1.502     raeburn  4686:     my $startblock = 0;
                   4687:     my $endblock = 0;
1.1062    raeburn  4688:     my $triggerblock = '';
1.482     raeburn  4689:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4690: 
1.490     raeburn  4691:     # If uname is for a user, and activity is course-specific, i.e.,
                   4692:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4693: 
1.490     raeburn  4694:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73  raeburn  4695:          $activity eq 'groups' || $activity eq 'printout') &&
                   4696:         ($env{'request.course.id'})) {
1.490     raeburn  4697:         foreach my $key (keys(%live_courses)) {
                   4698:             if ($key ne $env{'request.course.id'}) {
                   4699:                 delete($live_courses{$key});
                   4700:             }
                   4701:         }
                   4702:     }
                   4703: 
                   4704:     my $otheruser = 0;
                   4705:     my %own_courses;
                   4706:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4707:         # Resource belongs to user other than current user.
                   4708:         $otheruser = 1;
                   4709:         # Gather courses for current user
                   4710:         %own_courses = 
                   4711:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4712:     }
                   4713: 
                   4714:     # Gather active course roles - course coordinator, instructor, 
                   4715:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4716: 
                   4717:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4718:         my ($cdom,$cnum);
                   4719:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4720:             $cdom = $env{'course.'.$course.'.domain'};
                   4721:             $cnum = $env{'course.'.$course.'.num'};
                   4722:         } else {
1.490     raeburn  4723:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4724:         }
                   4725:         my $no_ownblock = 0;
                   4726:         my $no_userblock = 0;
1.533     raeburn  4727:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4728:             # Check if current user has 'evb' priv for this
                   4729:             if (defined($own_courses{$course})) {
                   4730:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4731:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4732:                     if ($sec ne 'none') {
                   4733:                         $checkrole .= '/'.$sec;
                   4734:                     }
                   4735:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4736:                         $no_ownblock = 1;
                   4737:                         last;
                   4738:                     }
                   4739:                 }
                   4740:             }
                   4741:             # if they have 'evb' priv and are currently not playing student
                   4742:             next if (($no_ownblock) &&
                   4743:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4744:         }
1.474     raeburn  4745:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4746:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4747:             if ($sec ne 'none') {
1.482     raeburn  4748:                 $checkrole .= '/'.$sec;
1.474     raeburn  4749:             }
1.490     raeburn  4750:             if ($otheruser) {
                   4751:                 # Resource belongs to user other than current user.
                   4752:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4753:                 my (%allroles,%userroles);
                   4754:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4755:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4756:                         my ($trole,$tdom,$tnum,$tsec);
                   4757:                         if ($entry =~ /^cr/) {
                   4758:                             ($trole,$tdom,$tnum,$tsec) = 
                   4759:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4760:                         } else {
                   4761:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4762:                         }
                   4763:                         my ($spec,$area,$trest);
                   4764:                         $area = '/'.$tdom.'/'.$tnum;
                   4765:                         $trest = $tnum;
                   4766:                         if ($tsec ne '') {
                   4767:                             $area .= '/'.$tsec;
                   4768:                             $trest .= '/'.$tsec;
                   4769:                         }
                   4770:                         $spec = $trole.'.'.$area;
                   4771:                         if ($trole =~ /^cr/) {
                   4772:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4773:                                                               $tdom,$spec,$trest,$area);
                   4774:                         } else {
                   4775:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4776:                                                                 $tdom,$spec,$trest,$area);
                   4777:                         }
                   4778:                     }
1.1075.2.124  raeburn  4779:                     my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058    raeburn  4780:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4781:                         if ($1) {
                   4782:                             $no_userblock = 1;
                   4783:                             last;
                   4784:                         }
1.486     raeburn  4785:                     }
                   4786:                 }
1.490     raeburn  4787:             } else {
                   4788:                 # Resource belongs to current user
                   4789:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4790:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4791:                     $no_ownblock = 1;
                   4792:                     last;
                   4793:                 }
1.474     raeburn  4794:             }
                   4795:         }
                   4796:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4797:         next if (($no_ownblock) &&
1.491     albertel 4798:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4799:         next if ($no_userblock);
1.474     raeburn  4800: 
1.1075.2.128  raeburn  4801:         # Retrieve blocking times and identity of blocker for course
1.490     raeburn  4802:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4803:         
1.1062    raeburn  4804:         my ($start,$end,$trigger) = 
                   4805:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4806:         if (($start != 0) && 
                   4807:             (($startblock == 0) || ($startblock > $start))) {
                   4808:             $startblock = $start;
1.1062    raeburn  4809:             if ($trigger ne '') {
                   4810:                 $triggerblock = $trigger;
                   4811:             }
1.502     raeburn  4812:         }
                   4813:         if (($end != 0)  &&
                   4814:             (($endblock == 0) || ($endblock < $end))) {
                   4815:             $endblock = $end;
1.1062    raeburn  4816:             if ($trigger ne '') {
                   4817:                 $triggerblock = $trigger;
                   4818:             }
1.502     raeburn  4819:         }
1.490     raeburn  4820:     }
1.1062    raeburn  4821:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4822: }
                   4823: 
                   4824: sub get_blocks {
1.1062    raeburn  4825:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4826:     my $startblock = 0;
                   4827:     my $endblock = 0;
1.1062    raeburn  4828:     my $triggerblock = '';
1.490     raeburn  4829:     my $course = $cdom.'_'.$cnum;
                   4830:     $setters->{$course} = {};
                   4831:     $setters->{$course}{'staff'} = [];
                   4832:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4833:     $setters->{$course}{'triggers'} = [];
                   4834:     my (@blockers,%triggered);
                   4835:     my $now = time;
                   4836:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4837:     if ($activity eq 'docs') {
                   4838:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4839:         foreach my $block (@blockers) {
                   4840:             if ($block =~ /^firstaccess____(.+)$/) {
                   4841:                 my $item = $1;
                   4842:                 my $type = 'map';
                   4843:                 my $timersymb = $item;
                   4844:                 if ($item eq 'course') {
                   4845:                     $type = 'course';
                   4846:                 } elsif ($item =~ /___\d+___/) {
                   4847:                     $type = 'resource';
                   4848:                 } else {
                   4849:                     $timersymb = &Apache::lonnet::symbread($item);
                   4850:                 }
                   4851:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4852:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4853:                 $triggered{$block} = {
                   4854:                                        start => $start,
                   4855:                                        end   => $end,
                   4856:                                        type  => $type,
                   4857:                                      };
                   4858:             }
                   4859:         }
                   4860:     } else {
                   4861:         foreach my $block (keys(%commblocks)) {
                   4862:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4863:                 my ($start,$end) = ($1,$2);
                   4864:                 if ($start <= time && $end >= time) {
                   4865:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4866:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4867:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4868:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4869:                                     push(@blockers,$block);
                   4870:                                 }
                   4871:                             }
                   4872:                         }
                   4873:                     }
                   4874:                 }
                   4875:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4876:                 my $item = $1;
                   4877:                 my $timersymb = $item; 
                   4878:                 my $type = 'map';
                   4879:                 if ($item eq 'course') {
                   4880:                     $type = 'course';
                   4881:                 } elsif ($item =~ /___\d+___/) {
                   4882:                     $type = 'resource';
                   4883:                 } else {
                   4884:                     $timersymb = &Apache::lonnet::symbread($item);
                   4885:                 }
                   4886:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4887:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4888:                 if ($start && $end) {
                   4889:                     if (($start <= time) && ($end >= time)) {
                   4890:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4891:                             push(@blockers,$block);
                   4892:                             $triggered{$block} = {
                   4893:                                                    start => $start,
                   4894:                                                    end   => $end,
                   4895:                                                    type  => $type,
                   4896:                                                  };
                   4897:                         }
                   4898:                     }
1.490     raeburn  4899:                 }
1.1062    raeburn  4900:             }
                   4901:         }
                   4902:     }
                   4903:     foreach my $blocker (@blockers) {
                   4904:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4905:             &parse_block_record($commblocks{$blocker});
                   4906:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4907:         my ($start,$end,$triggertype);
                   4908:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4909:             ($start,$end) = ($1,$2);
                   4910:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4911:             $start = $triggered{$blocker}{'start'};
                   4912:             $end = $triggered{$blocker}{'end'};
                   4913:             $triggertype = $triggered{$blocker}{'type'};
                   4914:         }
                   4915:         if ($start) {
                   4916:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4917:             if ($triggertype) {
                   4918:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4919:             } else {
                   4920:                 push(@{$$setters{$course}{'triggers'}},0);
                   4921:             }
                   4922:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4923:                 $startblock = $start;
                   4924:                 if ($triggertype) {
                   4925:                     $triggerblock = $blocker;
1.474     raeburn  4926:                 }
                   4927:             }
1.1062    raeburn  4928:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4929:                $endblock = $end;
                   4930:                if ($triggertype) {
                   4931:                    $triggerblock = $blocker;
                   4932:                }
                   4933:             }
1.474     raeburn  4934:         }
                   4935:     }
1.1062    raeburn  4936:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4937: }
                   4938: 
                   4939: sub parse_block_record {
                   4940:     my ($record) = @_;
                   4941:     my ($setuname,$setudom,$title,$blocks);
                   4942:     if (ref($record) eq 'HASH') {
                   4943:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4944:         $title = &unescape($record->{'event'});
                   4945:         $blocks = $record->{'blocks'};
                   4946:     } else {
                   4947:         my @data = split(/:/,$record,3);
                   4948:         if (scalar(@data) eq 2) {
                   4949:             $title = $data[1];
                   4950:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4951:         } else {
                   4952:             ($setuname,$setudom,$title) = @data;
                   4953:         }
                   4954:         $blocks = { 'com' => 'on' };
                   4955:     }
                   4956:     return ($setuname,$setudom,$title,$blocks);
                   4957: }
                   4958: 
1.854     kalberla 4959: sub blocking_status {
1.1075.2.73  raeburn  4960:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4961:     my %setters;
1.890     droeschl 4962: 
1.1061    raeburn  4963: # check for active blocking
1.1062    raeburn  4964:     my ($startblock,$endblock,$triggerblock) = 
1.1075.2.73  raeburn  4965:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4966:     my $blocked = 0;
                   4967:     if ($startblock && $endblock) {
                   4968:         $blocked = 1;
                   4969:     }
1.890     droeschl 4970: 
1.1061    raeburn  4971: # caller just wants to know whether a block is active
                   4972:     if (!wantarray) { return $blocked; }
                   4973: 
                   4974: # build a link to a popup window containing the details
                   4975:     my $querystring  = "?activity=$activity";
                   4976: # $uname and $udom decide whose portfolio the user is trying to look at
1.1075.2.97  raeburn  4977:     if (($activity eq 'port') || ($activity eq 'passwd')) {
                   4978:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);
                   4979:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  4980:     } elsif ($activity eq 'docs') {
                   4981:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4982:     }
1.1061    raeburn  4983: 
                   4984:     my $output .= <<'END_MYBLOCK';
                   4985: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4986:     var options = "width=" + w + ",height=" + h + ",";
                   4987:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4988:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4989:     var newWin = window.open(url, wdwName, options);
                   4990:     newWin.focus();
                   4991: }
1.890     droeschl 4992: END_MYBLOCK
1.854     kalberla 4993: 
1.1061    raeburn  4994:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4995:   
1.1061    raeburn  4996:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4997:     my $text = &mt('Communication Blocked');
1.1075.2.93  raeburn  4998:     my $class = 'LC_comblock';
1.1062    raeburn  4999:     if ($activity eq 'docs') {
                   5000:         $text = &mt('Content Access Blocked');
1.1075.2.93  raeburn  5001:         $class = '';
1.1063    raeburn  5002:     } elsif ($activity eq 'printout') {
                   5003:         $text = &mt('Printing Blocked');
1.1075.2.97  raeburn  5004:     } elsif ($activity eq 'passwd') {
                   5005:         $text = &mt('Password Changing Blocked');
1.1062    raeburn  5006:     }
1.1061    raeburn  5007:     $output .= <<"END_BLOCK";
1.1075.2.93  raeburn  5008: <div class='$class'>
1.869     kalberla 5009:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5010:   title='$text'>
                   5011:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5012:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5013:   title='$text'>$text</a>
1.867     kalberla 5014: </div>
                   5015: 
                   5016: END_BLOCK
1.474     raeburn  5017: 
1.1061    raeburn  5018:     return ($blocked, $output);
1.854     kalberla 5019: }
1.490     raeburn  5020: 
1.60      matthew  5021: ###############################################
                   5022: 
1.682     raeburn  5023: sub check_ip_acc {
1.1075.2.105  raeburn  5024:     my ($acc,$clientip)=@_;
1.682     raeburn  5025:     &Apache::lonxml::debug("acc is $acc");
                   5026:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5027:         return 1;
                   5028:     }
                   5029:     my $allowed=0;
1.1075.2.111  raeburn  5030:     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682     raeburn  5031: 
                   5032:     my $name;
                   5033:     foreach my $pattern (split(',',$acc)) {
                   5034:         $pattern =~ s/^\s*//;
                   5035:         $pattern =~ s/\s*$//;
                   5036:         if ($pattern =~ /\*$/) {
                   5037:             #35.8.*
                   5038:             $pattern=~s/\*//;
                   5039:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   5040:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5041:             #35.8.3.[34-56]
                   5042:             my $low=$2;
                   5043:             my $high=$3;
                   5044:             $pattern=$1;
                   5045:             if ($ip =~ /^\Q$pattern\E/) {
                   5046:                 my $last=(split(/\./,$ip))[3];
                   5047:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   5048:             }
                   5049:         } elsif ($pattern =~ /^\*/) {
                   5050:             #*.msu.edu
                   5051:             $pattern=~s/\*//;
                   5052:             if (!defined($name)) {
                   5053:                 use Socket;
                   5054:                 my $netaddr=inet_aton($ip);
                   5055:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5056:             }
                   5057:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   5058:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5059:             #127.0.0.1
                   5060:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   5061:         } else {
                   5062:             #some.name.com
                   5063:             if (!defined($name)) {
                   5064:                 use Socket;
                   5065:                 my $netaddr=inet_aton($ip);
                   5066:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5067:             }
                   5068:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   5069:         }
                   5070:         if ($allowed) { last; }
                   5071:     }
                   5072:     return $allowed;
                   5073: }
                   5074: 
                   5075: ###############################################
                   5076: 
1.60      matthew  5077: =pod
                   5078: 
1.112     bowersj2 5079: =head1 Domain Template Functions
                   5080: 
                   5081: =over 4
                   5082: 
                   5083: =item * &determinedomain()
1.60      matthew  5084: 
                   5085: Inputs: $domain (usually will be undef)
                   5086: 
1.63      www      5087: Returns: Determines which domain should be used for designs
1.60      matthew  5088: 
                   5089: =cut
1.54      www      5090: 
1.60      matthew  5091: ###############################################
1.63      www      5092: sub determinedomain {
                   5093:     my $domain=shift;
1.531     albertel 5094:     if (! $domain) {
1.60      matthew  5095:         # Determine domain if we have not been given one
1.893     raeburn  5096:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5097:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5098:         if ($env{'request.role.domain'}) { 
                   5099:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5100:         }
                   5101:     }
1.63      www      5102:     return $domain;
                   5103: }
                   5104: ###############################################
1.517     raeburn  5105: 
1.518     albertel 5106: sub devalidate_domconfig_cache {
                   5107:     my ($udom)=@_;
                   5108:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5109: }
                   5110: 
                   5111: # ---------------------- Get domain configuration for a domain
                   5112: sub get_domainconf {
                   5113:     my ($udom) = @_;
                   5114:     my $cachetime=1800;
                   5115:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5116:     if (defined($cached)) { return %{$result}; }
                   5117: 
                   5118:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5119: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5120:     my (%designhash,%legacy);
1.518     albertel 5121:     if (keys(%domconfig) > 0) {
                   5122:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5123:             if (keys(%{$domconfig{'login'}})) {
                   5124:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5125:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87  raeburn  5126:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5127:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5128:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5129:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5130:                                         if ($key eq 'loginvia') {
                   5131:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5132:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5133:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5134:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5135:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5136:                                                 } else {
                   5137:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5138:                                                 }
1.948     raeburn  5139:                                             }
1.1075.2.87  raeburn  5140:                                         } elsif ($key eq 'headtag') {
                   5141:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5142:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5143:                                             }
1.946     raeburn  5144:                                         }
1.1075.2.87  raeburn  5145:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5146:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5147:                                         }
1.946     raeburn  5148:                                     }
                   5149:                                 }
                   5150:                             }
                   5151:                         } else {
                   5152:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5153:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5154:                                     $domconfig{'login'}{$key}{$img};
                   5155:                             }
1.699     raeburn  5156:                         }
                   5157:                     } else {
                   5158:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5159:                     }
1.632     raeburn  5160:                 }
                   5161:             } else {
                   5162:                 $legacy{'login'} = 1;
1.518     albertel 5163:             }
1.632     raeburn  5164:         } else {
                   5165:             $legacy{'login'} = 1;
1.518     albertel 5166:         }
                   5167:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5168:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5169:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5170:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5171:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5172:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5173:                         }
1.518     albertel 5174:                     }
                   5175:                 }
1.632     raeburn  5176:             } else {
                   5177:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5178:             }
1.632     raeburn  5179:         } else {
                   5180:             $legacy{'rolecolors'} = 1;
1.518     albertel 5181:         }
1.948     raeburn  5182:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5183:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5184:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5185:             }
                   5186:         }
1.632     raeburn  5187:         if (keys(%legacy) > 0) {
                   5188:             my %legacyhash = &get_legacy_domconf($udom);
                   5189:             foreach my $item (keys(%legacyhash)) {
                   5190:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5191:                     if ($legacy{'login'}) { 
                   5192:                         $designhash{$item} = $legacyhash{$item};
                   5193:                     }
                   5194:                 } else {
                   5195:                     if ($legacy{'rolecolors'}) {
                   5196:                         $designhash{$item} = $legacyhash{$item};
                   5197:                     }
1.518     albertel 5198:                 }
                   5199:             }
                   5200:         }
1.632     raeburn  5201:     } else {
                   5202:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5203:     }
                   5204:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5205: 				  $cachetime);
                   5206:     return %designhash;
                   5207: }
                   5208: 
1.632     raeburn  5209: sub get_legacy_domconf {
                   5210:     my ($udom) = @_;
                   5211:     my %legacyhash;
                   5212:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5213:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5214:     if (-e $designfile) {
1.1075.2.128  raeburn  5215:         if ( open (my $fh,'<',$designfile) ) {
1.632     raeburn  5216:             while (my $line = <$fh>) {
                   5217:                 next if ($line =~ /^\#/);
                   5218:                 chomp($line);
                   5219:                 my ($key,$val)=(split(/\=/,$line));
                   5220:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5221:             }
                   5222:             close($fh);
                   5223:         }
                   5224:     }
1.1026    raeburn  5225:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5226:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5227:     }
                   5228:     return %legacyhash;
                   5229: }
                   5230: 
1.63      www      5231: =pod
                   5232: 
1.112     bowersj2 5233: =item * &domainlogo()
1.63      www      5234: 
                   5235: Inputs: $domain (usually will be undef)
                   5236: 
                   5237: Returns: A link to a domain logo, if the domain logo exists.
                   5238: If the domain logo does not exist, a description of the domain.
                   5239: 
                   5240: =cut
1.112     bowersj2 5241: 
1.63      www      5242: ###############################################
                   5243: sub domainlogo {
1.517     raeburn  5244:     my $domain = &determinedomain(shift);
1.518     albertel 5245:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5246:     # See if there is a logo
                   5247:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5248:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5249:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5250: 	    if ($imgsrc =~ m{^/res/}) {
                   5251: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5252: 		&Apache::lonnet::repcopy($local_name);
                   5253: 	    }
                   5254: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  5255:         } 
                   5256:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 5257:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5258:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5259:     } else {
1.60      matthew  5260:         return '';
1.59      www      5261:     }
                   5262: }
1.63      www      5263: ##############################################
                   5264: 
                   5265: =pod
                   5266: 
1.112     bowersj2 5267: =item * &designparm()
1.63      www      5268: 
                   5269: Inputs: $which parameter; $domain (usually will be undef)
                   5270: 
                   5271: Returns: value of designparamter $which
                   5272: 
                   5273: =cut
1.112     bowersj2 5274: 
1.397     albertel 5275: 
1.400     albertel 5276: ##############################################
1.397     albertel 5277: sub designparm {
                   5278:     my ($which,$domain)=@_;
                   5279:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5280:         return $env{'environment.color.'.$which};
1.96      www      5281:     }
1.63      www      5282:     $domain=&determinedomain($domain);
1.1016    raeburn  5283:     my %domdesign;
                   5284:     unless ($domain eq 'public') {
                   5285:         %domdesign = &get_domainconf($domain);
                   5286:     }
1.520     raeburn  5287:     my $output;
1.517     raeburn  5288:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5289:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5290:     } else {
1.520     raeburn  5291:         $output = $defaultdesign{$which};
                   5292:     }
                   5293:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5294:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5295:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5296:             if ($output =~ m{^/res/}) {
                   5297:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5298:                 &Apache::lonnet::repcopy($local_name);
                   5299:             }
1.520     raeburn  5300:             $output = &lonhttpdurl($output);
                   5301:         }
1.63      www      5302:     }
1.520     raeburn  5303:     return $output;
1.63      www      5304: }
1.59      www      5305: 
1.822     bisitz   5306: ##############################################
                   5307: =pod
                   5308: 
1.832     bisitz   5309: =item * &authorspace()
                   5310: 
1.1028    raeburn  5311: Inputs: $url (usually will be undef).
1.832     bisitz   5312: 
1.1075.2.40  raeburn  5313: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5314:          directory being viewed (or for which action is being taken). 
                   5315:          If $url is provided, and begins /priv/<domain>/<uname>
                   5316:          the path will be that portion of the $context argument.
                   5317:          Otherwise the path will be for the author space of the current
                   5318:          user when the current role is author, or for that of the 
                   5319:          co-author/assistant co-author space when the current role 
                   5320:          is co-author or assistant co-author.
1.832     bisitz   5321: 
                   5322: =cut
                   5323: 
                   5324: sub authorspace {
1.1028    raeburn  5325:     my ($url) = @_;
                   5326:     if ($url ne '') {
                   5327:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5328:            return $1;
                   5329:         }
                   5330:     }
1.832     bisitz   5331:     my $caname = '';
1.1024    www      5332:     my $cadom = '';
1.1028    raeburn  5333:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5334:         ($cadom,$caname) =
1.832     bisitz   5335:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5336:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5337:         $caname = $env{'user.name'};
1.1024    www      5338:         $cadom = $env{'user.domain'};
1.832     bisitz   5339:     }
1.1028    raeburn  5340:     if (($caname ne '') && ($cadom ne '')) {
                   5341:         return "/priv/$cadom/$caname/";
                   5342:     }
                   5343:     return;
1.832     bisitz   5344: }
                   5345: 
                   5346: ##############################################
                   5347: =pod
                   5348: 
1.822     bisitz   5349: =item * &head_subbox()
                   5350: 
                   5351: Inputs: $content (contains HTML code with page functions, etc.)
                   5352: 
                   5353: Returns: HTML div with $content
                   5354:          To be included in page header
                   5355: 
                   5356: =cut
                   5357: 
                   5358: sub head_subbox {
                   5359:     my ($content)=@_;
                   5360:     my $output =
1.993     raeburn  5361:         '<div class="LC_head_subbox">'
1.822     bisitz   5362:        .$content
                   5363:        .'</div>'
                   5364: }
                   5365: 
                   5366: ##############################################
                   5367: =pod
                   5368: 
                   5369: =item * &CSTR_pageheader()
                   5370: 
1.1026    raeburn  5371: Input: (optional) filename from which breadcrumb trail is built.
                   5372:        In most cases no input as needed, as $env{'request.filename'}
                   5373:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5374: 
                   5375: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  5376:          To be included on Authoring Space pages
1.822     bisitz   5377: 
                   5378: =cut
                   5379: 
                   5380: sub CSTR_pageheader {
1.1026    raeburn  5381:     my ($trailfile) = @_;
                   5382:     if ($trailfile eq '') {
                   5383:         $trailfile = $env{'request.filename'};
                   5384:     }
                   5385: 
                   5386: # this is for resources; directories have customtitle, and crumbs
                   5387: # and select recent are created in lonpubdir.pm
                   5388: 
                   5389:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5390:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  5391:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5392:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5393:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5394: 
                   5395:     my $parentpath = '';
                   5396:     my $lastitem = '';
                   5397:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5398:         $parentpath = $1;
                   5399:         $lastitem = $2;
                   5400:     } else {
                   5401:         $lastitem = $thisdisfn;
                   5402:     }
1.921     bisitz   5403: 
                   5404:     my $output =
1.822     bisitz   5405:          '<div>'
                   5406:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  5407:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5408:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5409:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5410:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5411: 
                   5412:     if ($lastitem) {
                   5413:         $output .=
                   5414:              '<span class="LC_filename">'
                   5415:             .$lastitem
                   5416:             .'</span>';
                   5417:     }
                   5418:     $output .=
                   5419:          '<br />'
1.822     bisitz   5420:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5421:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5422:         .'</form>'
                   5423:         .&Apache::lonmenu::constspaceform()
                   5424:         .'</div>';
1.921     bisitz   5425: 
                   5426:     return $output;
1.822     bisitz   5427: }
                   5428: 
1.60      matthew  5429: ###############################################
                   5430: ###############################################
                   5431: 
                   5432: =pod
                   5433: 
1.112     bowersj2 5434: =back
                   5435: 
1.549     albertel 5436: =head1 HTML Helpers
1.112     bowersj2 5437: 
                   5438: =over 4
                   5439: 
                   5440: =item * &bodytag()
1.60      matthew  5441: 
                   5442: Returns a uniform header for LON-CAPA web pages.
                   5443: 
                   5444: Inputs: 
                   5445: 
1.112     bowersj2 5446: =over 4
                   5447: 
                   5448: =item * $title, A title to be displayed on the page.
                   5449: 
                   5450: =item * $function, the current role (can be undef).
                   5451: 
                   5452: =item * $addentries, extra parameters for the <body> tag.
                   5453: 
                   5454: =item * $bodyonly, if defined, only return the <body> tag.
                   5455: 
                   5456: =item * $domain, if defined, force a given domain.
                   5457: 
                   5458: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5459:             text interface only)
1.60      matthew  5460: 
1.814     bisitz   5461: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5462:                      navigational links
1.317     albertel 5463: 
1.338     albertel 5464: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5465: 
1.1075.2.12  raeburn  5466: =item * $no_inline_link, if true and in remote mode, don't show the
                   5467:          'Switch To Inline Menu' link
                   5468: 
1.460     albertel 5469: =item * $args, optional argument valid values are
                   5470:             no_auto_mt_title -> prevents &mt()ing the title arg
1.1075.2.133  raeburn  5471:             use_absolute     -> for external resource or syllabus, this will
                   5472:                                 contain https://<hostname> if server uses
                   5473:                                 https (as per hosts.tab), but request is for http
                   5474:             hostname         -> hostname, from $r->hostname().
1.460     albertel 5475: 
1.1075.2.15  raeburn  5476: =item * $advtoolsref, optional argument, ref to an array containing
                   5477:             inlineremote items to be added in "Functions" menu below
                   5478:             breadcrumbs.
                   5479: 
1.112     bowersj2 5480: =back
                   5481: 
1.60      matthew  5482: Returns: A uniform header for LON-CAPA web pages.  
                   5483: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5484: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5485: other decorations will be returned.
                   5486: 
                   5487: =cut
                   5488: 
1.54      www      5489: sub bodytag {
1.831     bisitz   5490:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5491:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5492: 
1.954     raeburn  5493:     my $public;
                   5494:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5495:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5496:         $public = 1;
                   5497:     }
1.460     albertel 5498:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5499:     my $httphost = $args->{'use_absolute'};
1.1075.2.133  raeburn  5500:     my $hostname = $args->{'hostname'};
1.339     albertel 5501: 
1.183     matthew  5502:     $function = &get_users_function() if (!$function);
1.339     albertel 5503:     my $img =    &designparm($function.'.img',$domain);
                   5504:     my $font =   &designparm($function.'.font',$domain);
                   5505:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5506: 
1.803     bisitz   5507:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5508: 		   'bgcolor' => $pgbg,
1.339     albertel 5509: 		   'text'    => $font,
                   5510:                    'alink'   => &designparm($function.'.alink',$domain),
                   5511: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5512: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5513:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5514: 
1.63      www      5515:  # role and realm
1.1075.2.68  raeburn  5516:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5517:     if ($realm) {
                   5518:         $realm = '/'.$realm;
                   5519:     }
1.378     raeburn  5520:     if ($role  eq 'ca') {
1.479     albertel 5521:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5522:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5523:     } 
1.55      www      5524: # realm
1.258     albertel 5525:     if ($env{'request.course.id'}) {
1.378     raeburn  5526:         if ($env{'request.role'} !~ /^cr/) {
                   5527:             $role = &Apache::lonnet::plaintext($role,&course_type());
1.1075.2.115  raeburn  5528:         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1075.2.121  raeburn  5529:             if ($env{'request.role.desc'}) {
                   5530:                 $role = $env{'request.role.desc'};
                   5531:             } else {
                   5532:                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
                   5533:             }
1.1075.2.115  raeburn  5534:         } else {
                   5535:             $role = (split(/\//,$role,4))[-1];
1.378     raeburn  5536:         }
1.898     raeburn  5537:         if ($env{'request.course.sec'}) {
                   5538:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5539:         }   
1.359     albertel 5540: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5541:     } else {
                   5542:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5543:     }
1.433     albertel 5544: 
1.359     albertel 5545:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5546: 
1.438     albertel 5547:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5548: 
1.101     www      5549: # construct main body tag
1.359     albertel 5550:     my $bodytag = "<body $extra_body_attr>".
1.1075.2.100  raeburn  5551: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 5552: 
1.1075.2.38  raeburn  5553:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5554: 
                   5555:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5556:         return $bodytag;
1.1075.2.38  raeburn  5557:     }
1.359     albertel 5558: 
1.954     raeburn  5559:     if ($public) {
1.433     albertel 5560: 	undef($role);
                   5561:     }
1.359     albertel 5562:     
1.762     bisitz   5563:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5564:     #
                   5565:     # Extra info if you are the DC
                   5566:     my $dc_info = '';
                   5567:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5568:                         $env{'course.'.$env{'request.course.id'}.
                   5569:                                  '.domain'}.'/'})) {
                   5570:         my $cid = $env{'request.course.id'};
1.917     raeburn  5571:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5572:         $dc_info =~ s/\s+$//;
1.359     albertel 5573:     }
                   5574: 
1.1075.2.108  raeburn  5575:     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.903     droeschl 5576: 
1.1075.2.13  raeburn  5577:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5578: 
1.1075.2.38  raeburn  5579: 
                   5580: 
1.1075.2.21  raeburn  5581:     my $funclist;
                   5582:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5583:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5584:                     Apache::lonmenu::serverform();
                   5585:         my $forbodytag;
                   5586:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5587:                                             $forcereg,$args->{'group'},
                   5588:                                             $args->{'bread_crumbs'},
1.1075.2.133  raeburn  5589:                                             $advtoolsref,'','',\$forbodytag);
1.1075.2.21  raeburn  5590:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5591:             $funclist = $forbodytag;
                   5592:         }
                   5593:     } else {
1.903     droeschl 5594: 
                   5595:         #    if ($env{'request.state'} eq 'construct') {
                   5596:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5597:         #    }
                   5598: 
1.1075.2.38  raeburn  5599:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5600:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5601: 
1.1075.2.38  raeburn  5602:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5603: 
1.916     droeschl 5604:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5605:             if ($dc_info) {
                   5606:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5607:             }
1.1075.2.38  raeburn  5608:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5609:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5610:             return $bodytag;
                   5611:         }
1.894     droeschl 5612: 
1.927     raeburn  5613:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5614:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5615:         }
1.916     droeschl 5616: 
1.1075.2.38  raeburn  5617:         $bodytag .= $right;
1.852     droeschl 5618: 
1.917     raeburn  5619:         if ($dc_info) {
                   5620:             $dc_info = &dc_courseid_toggle($dc_info);
                   5621:         }
                   5622:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5623: 
1.1075.2.61  raeburn  5624:         #if directed to not display the secondary menu, don't.
                   5625:         if ($args->{'no_secondary_menu'}) {
                   5626:             return $bodytag;
                   5627:         }
1.903     droeschl 5628:         #don't show menus for public users
1.954     raeburn  5629:         if (!$public){
1.1075.2.52  raeburn  5630:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5631:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5632:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5633:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5634:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1075.2.133  raeburn  5635:                                 $args->{'bread_crumbs'},'','',$hostname);
1.1075.2.116  raeburn  5636:             } elsif ($forcereg) {
1.1075.2.22  raeburn  5637:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1075.2.116  raeburn  5638:                                                             $args->{'group'},
1.1075.2.133  raeburn  5639:                                                             $args->{'hide_buttons',
                   5640:                                                             $hostname});
1.1075.2.15  raeburn  5641:             } else {
1.1075.2.21  raeburn  5642:                 my $forbodytag;
                   5643:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5644:                                                     $forcereg,$args->{'group'},
                   5645:                                                     $args->{'bread_crumbs'},
1.1075.2.133  raeburn  5646:                                                     $advtoolsref,'',$hostname,
                   5647:                                                     \$forbodytag);
1.1075.2.21  raeburn  5648:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5649:                     $bodytag .= $forbodytag;
                   5650:                 }
1.920     raeburn  5651:             }
1.903     droeschl 5652:         }else{
                   5653:             # this is to seperate menu from content when there's no secondary
                   5654:             # menu. Especially needed for public accessible ressources.
                   5655:             $bodytag .= '<hr style="clear:both" />';
                   5656:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5657:         }
1.903     droeschl 5658: 
1.235     raeburn  5659:         return $bodytag;
1.1075.2.12  raeburn  5660:     }
                   5661: 
                   5662: #
                   5663: # Top frame rendering, Remote is up
                   5664: #
                   5665: 
                   5666:     my $imgsrc = $img;
                   5667:     if ($img =~ /^\/adm/) {
                   5668:         $imgsrc = &lonhttpdurl($img);
                   5669:     }
                   5670:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5671: 
1.1075.2.60  raeburn  5672:     my $help=($no_inline_link?''
                   5673:               :&Apache::loncommon::top_nav_help('Help'));
                   5674: 
1.1075.2.12  raeburn  5675:     # Explicit link to get inline menu
                   5676:     my $menu= ($no_inline_link?''
                   5677:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5678: 
                   5679:     if ($dc_info) {
                   5680:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5681:     }
                   5682: 
1.1075.2.38  raeburn  5683:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5684:     unless ($public) {
                   5685:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5686:                                 undef,'LC_menubuttons_link');
                   5687:     }
                   5688: 
1.1075.2.12  raeburn  5689:     unless ($env{'form.inhibitmenu'}) {
                   5690:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5691:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5692:                        <li>$help</li>
1.1075.2.12  raeburn  5693:                        <li>$menu</li>
                   5694:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5695:     }
1.1075.2.13  raeburn  5696:     if ($env{'request.state'} eq 'construct') {
                   5697:         if (!$public){
                   5698:             if ($env{'request.state'} eq 'construct') {
                   5699:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5700:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5701:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5702:                             &Apache::lonmenu::innerregister($forcereg,
                   5703:                                                             $args->{'bread_crumbs'});
                   5704:             }
                   5705:         }
                   5706:     }
1.1075.2.21  raeburn  5707:     return $bodytag."\n".$funclist;
1.182     matthew  5708: }
                   5709: 
1.917     raeburn  5710: sub dc_courseid_toggle {
                   5711:     my ($dc_info) = @_;
1.980     raeburn  5712:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5713:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5714:            &mt('(More ...)').'</a></span>'.
                   5715:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5716: }
                   5717: 
1.330     albertel 5718: sub make_attr_string {
                   5719:     my ($register,$attr_ref) = @_;
                   5720: 
                   5721:     if ($attr_ref && !ref($attr_ref)) {
                   5722: 	die("addentries Must be a hash ref ".
                   5723: 	    join(':',caller(1))." ".
                   5724: 	    join(':',caller(0))." ");
                   5725:     }
                   5726: 
                   5727:     if ($register) {
1.339     albertel 5728: 	my ($on_load,$on_unload);
                   5729: 	foreach my $key (keys(%{$attr_ref})) {
                   5730: 	    if      (lc($key) eq 'onload') {
                   5731: 		$on_load.=$attr_ref->{$key}.';';
                   5732: 		delete($attr_ref->{$key});
                   5733: 
                   5734: 	    } elsif (lc($key) eq 'onunload') {
                   5735: 		$on_unload.=$attr_ref->{$key}.';';
                   5736: 		delete($attr_ref->{$key});
                   5737: 	    }
                   5738: 	}
1.1075.2.12  raeburn  5739:         if ($env{'environment.remote'} eq 'on') {
                   5740:             $attr_ref->{'onload'}  =
                   5741:                 &Apache::lonmenu::loadevents().  $on_load;
                   5742:             $attr_ref->{'onunload'}=
                   5743:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5744:         } else {  
                   5745: 	    $attr_ref->{'onload'}  = $on_load;
                   5746: 	    $attr_ref->{'onunload'}= $on_unload;
                   5747:         }
1.330     albertel 5748:     }
1.339     albertel 5749: 
1.330     albertel 5750:     my $attr_string;
1.1075.2.56  raeburn  5751:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5752: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5753:     }
                   5754:     return $attr_string;
                   5755: }
                   5756: 
                   5757: 
1.182     matthew  5758: ###############################################
1.251     albertel 5759: ###############################################
                   5760: 
                   5761: =pod
                   5762: 
                   5763: =item * &endbodytag()
                   5764: 
                   5765: Returns a uniform footer for LON-CAPA web pages.
                   5766: 
1.635     raeburn  5767: Inputs: 1 - optional reference to an args hash
                   5768: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5769: a 'Continue' link is not displayed if the page contains an
                   5770: internal redirect in the <head></head> section,
                   5771: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5772: 
                   5773: =cut
                   5774: 
                   5775: sub endbodytag {
1.635     raeburn  5776:     my ($args) = @_;
1.1075.2.6  raeburn  5777:     my $endbodytag;
                   5778:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5779:         $endbodytag='</body>';
                   5780:     }
1.315     albertel 5781:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5782:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5783: 	    $endbodytag=
                   5784: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5785: 	        &mt('Continue').'</a>'.
                   5786: 	        $endbodytag;
                   5787:         }
1.315     albertel 5788:     }
1.251     albertel 5789:     return $endbodytag;
                   5790: }
                   5791: 
1.352     albertel 5792: =pod
                   5793: 
                   5794: =item * &standard_css()
                   5795: 
                   5796: Returns a style sheet
                   5797: 
                   5798: Inputs: (all optional)
                   5799:             domain         -> force to color decorate a page for a specific
                   5800:                                domain
                   5801:             function       -> force usage of a specific rolish color scheme
                   5802:             bgcolor        -> override the default page bgcolor
                   5803: 
                   5804: =cut
                   5805: 
1.343     albertel 5806: sub standard_css {
1.345     albertel 5807:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5808:     $function  = &get_users_function() if (!$function);
                   5809:     my $img    = &designparm($function.'.img',   $domain);
                   5810:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5811:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5812:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5813: #second colour for later usage
1.345     albertel 5814:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5815:     my $pgbg_or_bgcolor =
                   5816: 	         $bgcolor ||
1.352     albertel 5817: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5818:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5819:     my $alink  = &designparm($function.'.alink', $domain);
                   5820:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5821:     my $link   = &designparm($function.'.link',  $domain);
                   5822: 
1.602     albertel 5823:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5824:     my $mono                 = 'monospace';
1.850     bisitz   5825:     my $data_table_head      = $sidebg;
                   5826:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5827:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5828:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5829:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5830:     my $mail_new             = '#FFBB77';
                   5831:     my $mail_new_hover       = '#DD9955';
                   5832:     my $mail_read            = '#BBBB77';
                   5833:     my $mail_read_hover      = '#999944';
                   5834:     my $mail_replied         = '#AAAA88';
                   5835:     my $mail_replied_hover   = '#888855';
                   5836:     my $mail_other           = '#99BBBB';
                   5837:     my $mail_other_hover     = '#669999';
1.391     albertel 5838:     my $table_header         = '#DDDDDD';
1.489     raeburn  5839:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5840:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5841:     my $button_hover         = '#BF2317';
1.392     albertel 5842: 
1.608     albertel 5843:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5844:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5845:                                              : '0 3px 0 4px';
1.448     albertel 5846: 
1.523     albertel 5847: 
1.343     albertel 5848:     return <<END;
1.947     droeschl 5849: 
                   5850: /* needed for iframe to allow 100% height in FF */
                   5851: body, html { 
                   5852:     margin: 0;
                   5853:     padding: 0 0.5%;
                   5854:     height: 99%; /* to avoid scrollbars */
                   5855: }
                   5856: 
1.795     www      5857: body {
1.911     bisitz   5858:   font-family: $sans;
                   5859:   line-height:130%;
                   5860:   font-size:0.83em;
                   5861:   color:$font;
1.795     www      5862: }
                   5863: 
1.959     onken    5864: a:focus,
                   5865: a:focus img {
1.795     www      5866:   color: red;
                   5867: }
1.698     harmsja  5868: 
1.911     bisitz   5869: form, .inline {
                   5870:   display: inline;
1.795     www      5871: }
1.721     harmsja  5872: 
1.795     www      5873: .LC_right {
1.911     bisitz   5874:   text-align:right;
1.795     www      5875: }
                   5876: 
                   5877: .LC_middle {
1.911     bisitz   5878:   vertical-align:middle;
1.795     www      5879: }
1.721     harmsja  5880: 
1.1075.2.38  raeburn  5881: .LC_floatleft {
                   5882:   float: left;
                   5883: }
                   5884: 
                   5885: .LC_floatright {
                   5886:   float: right;
                   5887: }
                   5888: 
1.911     bisitz   5889: .LC_400Box {
                   5890:   width:400px;
                   5891: }
1.721     harmsja  5892: 
1.947     droeschl 5893: .LC_iframecontainer {
                   5894:     width: 98%;
                   5895:     margin: 0;
                   5896:     position: fixed;
                   5897:     top: 8.5em;
                   5898:     bottom: 0;
                   5899: }
                   5900: 
                   5901: .LC_iframecontainer iframe{
                   5902:     border: none;
                   5903:     width: 100%;
                   5904:     height: 100%;
                   5905: }
                   5906: 
1.778     bisitz   5907: .LC_filename {
                   5908:   font-family: $mono;
                   5909:   white-space:pre;
1.921     bisitz   5910:   font-size: 120%;
1.778     bisitz   5911: }
                   5912: 
                   5913: .LC_fileicon {
                   5914:   border: none;
                   5915:   height: 1.3em;
                   5916:   vertical-align: text-bottom;
                   5917:   margin-right: 0.3em;
                   5918:   text-decoration:none;
                   5919: }
                   5920: 
1.1008    www      5921: .LC_setting {
                   5922:   text-decoration:underline;
                   5923: }
                   5924: 
1.350     albertel 5925: .LC_error {
                   5926:   color: red;
                   5927: }
1.795     www      5928: 
1.1075.2.15  raeburn  5929: .LC_warning {
                   5930:   color: darkorange;
                   5931: }
                   5932: 
1.457     albertel 5933: .LC_diff_removed {
1.733     bisitz   5934:   color: red;
1.394     albertel 5935: }
1.532     albertel 5936: 
                   5937: .LC_info,
1.457     albertel 5938: .LC_success,
                   5939: .LC_diff_added {
1.350     albertel 5940:   color: green;
                   5941: }
1.795     www      5942: 
1.802     bisitz   5943: div.LC_confirm_box {
                   5944:   background-color: #FAFAFA;
                   5945:   border: 1px solid $lg_border_color;
                   5946:   margin-right: 0;
                   5947:   padding: 5px;
                   5948: }
                   5949: 
                   5950: div.LC_confirm_box .LC_error img,
                   5951: div.LC_confirm_box .LC_success img {
                   5952:   vertical-align: middle;
                   5953: }
                   5954: 
1.1075.2.108  raeburn  5955: .LC_maxwidth {
                   5956:   max-width: 100%;
                   5957:   height: auto;
                   5958: }
                   5959: 
                   5960: .LC_textsize_mobile {
                   5961:   \@media only screen and (max-device-width: 480px) {
                   5962:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   5963:   }
                   5964: }
                   5965: 
1.440     albertel 5966: .LC_icon {
1.771     droeschl 5967:   border: none;
1.790     droeschl 5968:   vertical-align: middle;
1.771     droeschl 5969: }
                   5970: 
1.543     albertel 5971: .LC_docs_spacer {
                   5972:   width: 25px;
                   5973:   height: 1px;
1.771     droeschl 5974:   border: none;
1.543     albertel 5975: }
1.346     albertel 5976: 
1.532     albertel 5977: .LC_internal_info {
1.735     bisitz   5978:   color: #999999;
1.532     albertel 5979: }
                   5980: 
1.794     www      5981: .LC_discussion {
1.1050    www      5982:   background: $data_table_dark;
1.911     bisitz   5983:   border: 1px solid black;
                   5984:   margin: 2px;
1.794     www      5985: }
                   5986: 
                   5987: .LC_disc_action_left {
1.1050    www      5988:   background: $sidebg;
1.911     bisitz   5989:   text-align: left;
1.1050    www      5990:   padding: 4px;
                   5991:   margin: 2px;
1.794     www      5992: }
                   5993: 
                   5994: .LC_disc_action_right {
1.1050    www      5995:   background: $sidebg;
1.911     bisitz   5996:   text-align: right;
1.1050    www      5997:   padding: 4px;
                   5998:   margin: 2px;
1.794     www      5999: }
                   6000: 
                   6001: .LC_disc_new_item {
1.911     bisitz   6002:   background: white;
                   6003:   border: 2px solid red;
1.1050    www      6004:   margin: 4px;
                   6005:   padding: 4px;
1.794     www      6006: }
                   6007: 
                   6008: .LC_disc_old_item {
1.911     bisitz   6009:   background: white;
1.1050    www      6010:   margin: 4px;
                   6011:   padding: 4px;
1.794     www      6012: }
                   6013: 
1.458     albertel 6014: table.LC_pastsubmission {
                   6015:   border: 1px solid black;
                   6016:   margin: 2px;
                   6017: }
                   6018: 
1.924     bisitz   6019: table#LC_menubuttons {
1.345     albertel 6020:   width: 100%;
                   6021:   background: $pgbg;
1.392     albertel 6022:   border: 2px;
1.402     albertel 6023:   border-collapse: separate;
1.803     bisitz   6024:   padding: 0;
1.345     albertel 6025: }
1.392     albertel 6026: 
1.801     tempelho 6027: table#LC_title_bar a {
                   6028:   color: $fontmenu;
                   6029: }
1.836     bisitz   6030: 
1.807     droeschl 6031: table#LC_title_bar {
1.819     tempelho 6032:   clear: both;
1.836     bisitz   6033:   display: none;
1.807     droeschl 6034: }
                   6035: 
1.795     www      6036: table#LC_title_bar,
1.933     droeschl 6037: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 6038: table#LC_title_bar.LC_with_remote {
1.359     albertel 6039:   width: 100%;
1.392     albertel 6040:   border-color: $pgbg;
                   6041:   border-style: solid;
                   6042:   border-width: $border;
1.379     albertel 6043:   background: $pgbg;
1.801     tempelho 6044:   color: $fontmenu;
1.392     albertel 6045:   border-collapse: collapse;
1.803     bisitz   6046:   padding: 0;
1.819     tempelho 6047:   margin: 0;
1.359     albertel 6048: }
1.795     www      6049: 
1.933     droeschl 6050: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 6051:     margin: 0;
                   6052:     padding: 0;
1.933     droeschl 6053:     position: relative;
                   6054:     list-style: none;
1.913     droeschl 6055: }
1.933     droeschl 6056: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 6057:     display: inline;
                   6058: }
1.933     droeschl 6059: 
                   6060: .LC_breadcrumb_tools_navigation {
1.913     droeschl 6061:     padding: 0;
1.933     droeschl 6062:     margin: 0;
                   6063:     float: left;
1.913     droeschl 6064: }
1.933     droeschl 6065: .LC_breadcrumb_tools_tools {
                   6066:     padding: 0;
                   6067:     margin: 0;
1.913     droeschl 6068:     float: right;
                   6069: }
                   6070: 
1.359     albertel 6071: table#LC_title_bar td {
                   6072:   background: $tabbg;
                   6073: }
1.795     www      6074: 
1.911     bisitz   6075: table#LC_menubuttons img {
1.803     bisitz   6076:   border: none;
1.346     albertel 6077: }
1.795     www      6078: 
1.842     droeschl 6079: .LC_breadcrumbs_component {
1.911     bisitz   6080:   float: right;
                   6081:   margin: 0 1em;
1.357     albertel 6082: }
1.842     droeschl 6083: .LC_breadcrumbs_component img {
1.911     bisitz   6084:   vertical-align: middle;
1.777     tempelho 6085: }
1.795     www      6086: 
1.1075.2.108  raeburn  6087: .LC_breadcrumbs_hoverable {
                   6088:   background: $sidebg;
                   6089: }
                   6090: 
1.383     albertel 6091: td.LC_table_cell_checkbox {
                   6092:   text-align: center;
                   6093: }
1.795     www      6094: 
                   6095: .LC_fontsize_small {
1.911     bisitz   6096:   font-size: 70%;
1.705     tempelho 6097: }
                   6098: 
1.844     bisitz   6099: #LC_breadcrumbs {
1.911     bisitz   6100:   clear:both;
                   6101:   background: $sidebg;
                   6102:   border-bottom: 1px solid $lg_border_color;
                   6103:   line-height: 2.5em;
1.933     droeschl 6104:   overflow: hidden;
1.911     bisitz   6105:   margin: 0;
                   6106:   padding: 0;
1.995     raeburn  6107:   text-align: left;
1.819     tempelho 6108: }
1.862     bisitz   6109: 
1.1075.2.16  raeburn  6110: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6111:   clear:both;
                   6112:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6113:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  6114:   margin: 0 0 10px 0;
1.966     bisitz   6115:   padding: 3px;
1.995     raeburn  6116:   text-align: left;
1.822     bisitz   6117: }
                   6118: 
1.795     www      6119: .LC_fontsize_medium {
1.911     bisitz   6120:   font-size: 85%;
1.705     tempelho 6121: }
                   6122: 
1.795     www      6123: .LC_fontsize_large {
1.911     bisitz   6124:   font-size: 120%;
1.705     tempelho 6125: }
                   6126: 
1.346     albertel 6127: .LC_menubuttons_inline_text {
                   6128:   color: $font;
1.698     harmsja  6129:   font-size: 90%;
1.701     harmsja  6130:   padding-left:3px;
1.346     albertel 6131: }
                   6132: 
1.934     droeschl 6133: .LC_menubuttons_inline_text img{
                   6134:   vertical-align: middle;
                   6135: }
                   6136: 
1.1051    www      6137: li.LC_menubuttons_inline_text img {
1.951     onken    6138:   cursor:pointer;
1.1002    droeschl 6139:   text-decoration: none;
1.951     onken    6140: }
                   6141: 
1.526     www      6142: .LC_menubuttons_link {
                   6143:   text-decoration: none;
                   6144: }
1.795     www      6145: 
1.522     albertel 6146: .LC_menubuttons_category {
1.521     www      6147:   color: $font;
1.526     www      6148:   background: $pgbg;
1.521     www      6149:   font-size: larger;
                   6150:   font-weight: bold;
                   6151: }
                   6152: 
1.346     albertel 6153: td.LC_menubuttons_text {
1.911     bisitz   6154:   color: $font;
1.346     albertel 6155: }
1.706     harmsja  6156: 
1.346     albertel 6157: .LC_current_location {
                   6158:   background: $tabbg;
                   6159: }
1.795     www      6160: 
1.1075.2.134  raeburn  6161: td.LC_zero_height {
                   6162:   line-height: 0;
                   6163:   cellpadding: 0;
                   6164: }
                   6165: 
1.938     bisitz   6166: table.LC_data_table {
1.347     albertel 6167:   border: 1px solid #000000;
1.402     albertel 6168:   border-collapse: separate;
1.426     albertel 6169:   border-spacing: 1px;
1.610     albertel 6170:   background: $pgbg;
1.347     albertel 6171: }
1.795     www      6172: 
1.422     albertel 6173: .LC_data_table_dense {
                   6174:   font-size: small;
                   6175: }
1.795     www      6176: 
1.507     raeburn  6177: table.LC_nested_outer {
                   6178:   border: 1px solid #000000;
1.589     raeburn  6179:   border-collapse: collapse;
1.803     bisitz   6180:   border-spacing: 0;
1.507     raeburn  6181:   width: 100%;
                   6182: }
1.795     www      6183: 
1.879     raeburn  6184: table.LC_innerpickbox,
1.507     raeburn  6185: table.LC_nested {
1.803     bisitz   6186:   border: none;
1.589     raeburn  6187:   border-collapse: collapse;
1.803     bisitz   6188:   border-spacing: 0;
1.507     raeburn  6189:   width: 100%;
                   6190: }
1.795     www      6191: 
1.911     bisitz   6192: table.LC_data_table tr th,
                   6193: table.LC_calendar tr th,
1.879     raeburn  6194: table.LC_prior_tries tr th,
                   6195: table.LC_innerpickbox tr th {
1.349     albertel 6196:   font-weight: bold;
                   6197:   background-color: $data_table_head;
1.801     tempelho 6198:   color:$fontmenu;
1.701     harmsja  6199:   font-size:90%;
1.347     albertel 6200: }
1.795     www      6201: 
1.879     raeburn  6202: table.LC_innerpickbox tr th,
                   6203: table.LC_innerpickbox tr td {
                   6204:   vertical-align: top;
                   6205: }
                   6206: 
1.711     raeburn  6207: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   6208:   background-color: #CCCCCC;
1.711     raeburn  6209:   font-weight: bold;
                   6210:   text-align: left;
                   6211: }
1.795     www      6212: 
1.912     bisitz   6213: table.LC_data_table tr.LC_odd_row > td {
                   6214:   background-color: $data_table_light;
                   6215:   padding: 2px;
                   6216:   vertical-align: top;
                   6217: }
                   6218: 
1.809     bisitz   6219: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 6220:   background-color: $data_table_light;
1.912     bisitz   6221:   vertical-align: top;
                   6222: }
                   6223: 
                   6224: table.LC_data_table tr.LC_even_row > td {
                   6225:   background-color: $data_table_dark;
1.425     albertel 6226:   padding: 2px;
1.900     bisitz   6227:   vertical-align: top;
1.347     albertel 6228: }
1.795     www      6229: 
1.809     bisitz   6230: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 6231:   background-color: $data_table_dark;
1.900     bisitz   6232:   vertical-align: top;
1.347     albertel 6233: }
1.795     www      6234: 
1.425     albertel 6235: table.LC_data_table tr.LC_data_table_highlight td {
                   6236:   background-color: $data_table_darker;
                   6237: }
1.795     www      6238: 
1.639     raeburn  6239: table.LC_data_table tr td.LC_leftcol_header {
                   6240:   background-color: $data_table_head;
                   6241:   font-weight: bold;
                   6242: }
1.795     www      6243: 
1.451     albertel 6244: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  6245: table.LC_nested tr.LC_empty_row td {
1.421     albertel 6246:   font-weight: bold;
                   6247:   font-style: italic;
                   6248:   text-align: center;
                   6249:   padding: 8px;
1.347     albertel 6250: }
1.795     www      6251: 
1.1075.2.30  raeburn  6252: table.LC_data_table tr.LC_empty_row td,
                   6253: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   6254:   background-color: $sidebg;
                   6255: }
                   6256: 
                   6257: table.LC_nested tr.LC_empty_row td {
                   6258:   background-color: #FFFFFF;
                   6259: }
                   6260: 
1.890     droeschl 6261: table.LC_caption {
                   6262: }
                   6263: 
1.507     raeburn  6264: table.LC_nested tr.LC_empty_row td {
1.465     albertel 6265:   padding: 4ex
                   6266: }
1.795     www      6267: 
1.507     raeburn  6268: table.LC_nested_outer tr th {
                   6269:   font-weight: bold;
1.801     tempelho 6270:   color:$fontmenu;
1.507     raeburn  6271:   background-color: $data_table_head;
1.701     harmsja  6272:   font-size: small;
1.507     raeburn  6273:   border-bottom: 1px solid #000000;
                   6274: }
1.795     www      6275: 
1.507     raeburn  6276: table.LC_nested_outer tr td.LC_subheader {
                   6277:   background-color: $data_table_head;
                   6278:   font-weight: bold;
                   6279:   font-size: small;
                   6280:   border-bottom: 1px solid #000000;
                   6281:   text-align: right;
1.451     albertel 6282: }
1.795     www      6283: 
1.507     raeburn  6284: table.LC_nested tr.LC_info_row td {
1.735     bisitz   6285:   background-color: #CCCCCC;
1.451     albertel 6286:   font-weight: bold;
                   6287:   font-size: small;
1.507     raeburn  6288:   text-align: center;
                   6289: }
1.795     www      6290: 
1.589     raeburn  6291: table.LC_nested tr.LC_info_row td.LC_left_item,
                   6292: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  6293:   text-align: left;
1.451     albertel 6294: }
1.795     www      6295: 
1.507     raeburn  6296: table.LC_nested td {
1.735     bisitz   6297:   background-color: #FFFFFF;
1.451     albertel 6298:   font-size: small;
1.507     raeburn  6299: }
1.795     www      6300: 
1.507     raeburn  6301: table.LC_nested_outer tr th.LC_right_item,
                   6302: table.LC_nested tr.LC_info_row td.LC_right_item,
                   6303: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   6304: table.LC_nested tr td.LC_right_item {
1.451     albertel 6305:   text-align: right;
                   6306: }
                   6307: 
1.507     raeburn  6308: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   6309:   background-color: #EEEEEE;
1.451     albertel 6310: }
                   6311: 
1.473     raeburn  6312: table.LC_createuser {
                   6313: }
                   6314: 
                   6315: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  6316:   font-size: small;
1.473     raeburn  6317: }
                   6318: 
                   6319: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   6320:   background-color: #CCCCCC;
1.473     raeburn  6321:   font-weight: bold;
                   6322:   text-align: center;
                   6323: }
                   6324: 
1.349     albertel 6325: table.LC_calendar {
                   6326:   border: 1px solid #000000;
                   6327:   border-collapse: collapse;
1.917     raeburn  6328:   width: 98%;
1.349     albertel 6329: }
1.795     www      6330: 
1.349     albertel 6331: table.LC_calendar_pickdate {
                   6332:   font-size: xx-small;
                   6333: }
1.795     www      6334: 
1.349     albertel 6335: table.LC_calendar tr td {
                   6336:   border: 1px solid #000000;
                   6337:   vertical-align: top;
1.917     raeburn  6338:   width: 14%;
1.349     albertel 6339: }
1.795     www      6340: 
1.349     albertel 6341: table.LC_calendar tr td.LC_calendar_day_empty {
                   6342:   background-color: $data_table_dark;
                   6343: }
1.795     www      6344: 
1.779     bisitz   6345: table.LC_calendar tr td.LC_calendar_day_current {
                   6346:   background-color: $data_table_highlight;
1.777     tempelho 6347: }
1.795     www      6348: 
1.938     bisitz   6349: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 6350:   background-color: $mail_new;
                   6351: }
1.795     www      6352: 
1.938     bisitz   6353: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 6354:   background-color: $mail_new_hover;
                   6355: }
1.795     www      6356: 
1.938     bisitz   6357: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 6358:   background-color: $mail_read;
                   6359: }
1.795     www      6360: 
1.938     bisitz   6361: /*
                   6362: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 6363:   background-color: $mail_read_hover;
                   6364: }
1.938     bisitz   6365: */
1.795     www      6366: 
1.938     bisitz   6367: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 6368:   background-color: $mail_replied;
                   6369: }
1.795     www      6370: 
1.938     bisitz   6371: /*
                   6372: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 6373:   background-color: $mail_replied_hover;
                   6374: }
1.938     bisitz   6375: */
1.795     www      6376: 
1.938     bisitz   6377: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6378:   background-color: $mail_other;
                   6379: }
1.795     www      6380: 
1.938     bisitz   6381: /*
                   6382: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6383:   background-color: $mail_other_hover;
                   6384: }
1.938     bisitz   6385: */
1.494     raeburn  6386: 
1.777     tempelho 6387: table.LC_data_table tr > td.LC_browser_file,
                   6388: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6389:   background: #AAEE77;
1.389     albertel 6390: }
1.795     www      6391: 
1.777     tempelho 6392: table.LC_data_table tr > td.LC_browser_file_locked,
                   6393: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6394:   background: #FFAA99;
1.387     albertel 6395: }
1.795     www      6396: 
1.777     tempelho 6397: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6398:   background: #888888;
1.779     bisitz   6399: }
1.795     www      6400: 
1.777     tempelho 6401: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6402: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6403:   background: #F8F866;
1.777     tempelho 6404: }
1.795     www      6405: 
1.696     bisitz   6406: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6407:   background: #E0E8FF;
1.387     albertel 6408: }
1.696     bisitz   6409: 
1.707     bisitz   6410: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6411:   /* background: #77FF77; */
1.707     bisitz   6412: }
1.795     www      6413: 
1.707     bisitz   6414: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6415:   border-right: 8px solid #FFFF77;
1.707     bisitz   6416: }
1.795     www      6417: 
1.707     bisitz   6418: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6419:   border-right: 8px solid #FFAA77;
1.707     bisitz   6420: }
1.795     www      6421: 
1.707     bisitz   6422: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6423:   border-right: 8px solid #FF7777;
1.707     bisitz   6424: }
1.795     www      6425: 
1.707     bisitz   6426: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6427:   border-right: 8px solid #AAFF77;
1.707     bisitz   6428: }
1.795     www      6429: 
1.707     bisitz   6430: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6431:   border-right: 8px solid #11CC55;
1.707     bisitz   6432: }
                   6433: 
1.388     albertel 6434: span.LC_current_location {
1.701     harmsja  6435:   font-size:larger;
1.388     albertel 6436:   background: $pgbg;
                   6437: }
1.387     albertel 6438: 
1.1029    www      6439: span.LC_current_nav_location {
                   6440:   font-weight:bold;
                   6441:   background: $sidebg;
                   6442: }
                   6443: 
1.395     albertel 6444: span.LC_parm_menu_item {
                   6445:   font-size: larger;
                   6446: }
1.795     www      6447: 
1.395     albertel 6448: span.LC_parm_scope_all {
                   6449:   color: red;
                   6450: }
1.795     www      6451: 
1.395     albertel 6452: span.LC_parm_scope_folder {
                   6453:   color: green;
                   6454: }
1.795     www      6455: 
1.395     albertel 6456: span.LC_parm_scope_resource {
                   6457:   color: orange;
                   6458: }
1.795     www      6459: 
1.395     albertel 6460: span.LC_parm_part {
                   6461:   color: blue;
                   6462: }
1.795     www      6463: 
1.911     bisitz   6464: span.LC_parm_folder,
                   6465: span.LC_parm_symb {
1.395     albertel 6466:   font-size: x-small;
                   6467:   font-family: $mono;
                   6468:   color: #AAAAAA;
                   6469: }
                   6470: 
1.977     bisitz   6471: ul.LC_parm_parmlist li {
                   6472:   display: inline-block;
                   6473:   padding: 0.3em 0.8em;
                   6474:   vertical-align: top;
                   6475:   width: 150px;
                   6476:   border-top:1px solid $lg_border_color;
                   6477: }
                   6478: 
1.795     www      6479: td.LC_parm_overview_level_menu,
                   6480: td.LC_parm_overview_map_menu,
                   6481: td.LC_parm_overview_parm_selectors,
                   6482: td.LC_parm_overview_restrictions  {
1.396     albertel 6483:   border: 1px solid black;
                   6484:   border-collapse: collapse;
                   6485: }
1.795     www      6486: 
1.396     albertel 6487: table.LC_parm_overview_restrictions td {
                   6488:   border-width: 1px 4px 1px 4px;
                   6489:   border-style: solid;
                   6490:   border-color: $pgbg;
                   6491:   text-align: center;
                   6492: }
1.795     www      6493: 
1.396     albertel 6494: table.LC_parm_overview_restrictions th {
                   6495:   background: $tabbg;
                   6496:   border-width: 1px 4px 1px 4px;
                   6497:   border-style: solid;
                   6498:   border-color: $pgbg;
                   6499: }
1.795     www      6500: 
1.398     albertel 6501: table#LC_helpmenu {
1.803     bisitz   6502:   border: none;
1.398     albertel 6503:   height: 55px;
1.803     bisitz   6504:   border-spacing: 0;
1.398     albertel 6505: }
                   6506: 
                   6507: table#LC_helpmenu fieldset legend {
                   6508:   font-size: larger;
                   6509: }
1.795     www      6510: 
1.397     albertel 6511: table#LC_helpmenu_links {
                   6512:   width: 100%;
                   6513:   border: 1px solid black;
                   6514:   background: $pgbg;
1.803     bisitz   6515:   padding: 0;
1.397     albertel 6516:   border-spacing: 1px;
                   6517: }
1.795     www      6518: 
1.397     albertel 6519: table#LC_helpmenu_links tr td {
                   6520:   padding: 1px;
                   6521:   background: $tabbg;
1.399     albertel 6522:   text-align: center;
                   6523:   font-weight: bold;
1.397     albertel 6524: }
1.396     albertel 6525: 
1.795     www      6526: table#LC_helpmenu_links a:link,
                   6527: table#LC_helpmenu_links a:visited,
1.397     albertel 6528: table#LC_helpmenu_links a:active {
                   6529:   text-decoration: none;
                   6530:   color: $font;
                   6531: }
1.795     www      6532: 
1.397     albertel 6533: table#LC_helpmenu_links a:hover {
                   6534:   text-decoration: underline;
                   6535:   color: $vlink;
                   6536: }
1.396     albertel 6537: 
1.417     albertel 6538: .LC_chrt_popup_exists {
                   6539:   border: 1px solid #339933;
                   6540:   margin: -1px;
                   6541: }
1.795     www      6542: 
1.417     albertel 6543: .LC_chrt_popup_up {
                   6544:   border: 1px solid yellow;
                   6545:   margin: -1px;
                   6546: }
1.795     www      6547: 
1.417     albertel 6548: .LC_chrt_popup {
                   6549:   border: 1px solid #8888FF;
                   6550:   background: #CCCCFF;
                   6551: }
1.795     www      6552: 
1.421     albertel 6553: table.LC_pick_box {
                   6554:   border-collapse: separate;
                   6555:   background: white;
                   6556:   border: 1px solid black;
                   6557:   border-spacing: 1px;
                   6558: }
1.795     www      6559: 
1.421     albertel 6560: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6561:   background: $sidebg;
1.421     albertel 6562:   font-weight: bold;
1.900     bisitz   6563:   text-align: left;
1.740     bisitz   6564:   vertical-align: top;
1.421     albertel 6565:   width: 184px;
                   6566:   padding: 8px;
                   6567: }
1.795     www      6568: 
1.579     raeburn  6569: table.LC_pick_box td.LC_pick_box_value {
                   6570:   text-align: left;
                   6571:   padding: 8px;
                   6572: }
1.795     www      6573: 
1.579     raeburn  6574: table.LC_pick_box td.LC_pick_box_select {
                   6575:   text-align: left;
                   6576:   padding: 8px;
                   6577: }
1.795     www      6578: 
1.424     albertel 6579: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6580:   padding: 0;
1.421     albertel 6581:   height: 1px;
                   6582:   background: black;
                   6583: }
1.795     www      6584: 
1.421     albertel 6585: table.LC_pick_box td.LC_pick_box_submit {
                   6586:   text-align: right;
                   6587: }
1.795     www      6588: 
1.579     raeburn  6589: table.LC_pick_box td.LC_evenrow_value {
                   6590:   text-align: left;
                   6591:   padding: 8px;
                   6592:   background-color: $data_table_light;
                   6593: }
1.795     www      6594: 
1.579     raeburn  6595: table.LC_pick_box td.LC_oddrow_value {
                   6596:   text-align: left;
                   6597:   padding: 8px;
                   6598:   background-color: $data_table_light;
                   6599: }
1.795     www      6600: 
1.579     raeburn  6601: span.LC_helpform_receipt_cat {
                   6602:   font-weight: bold;
                   6603: }
1.795     www      6604: 
1.424     albertel 6605: table.LC_group_priv_box {
                   6606:   background: white;
                   6607:   border: 1px solid black;
                   6608:   border-spacing: 1px;
                   6609: }
1.795     www      6610: 
1.424     albertel 6611: table.LC_group_priv_box td.LC_pick_box_title {
                   6612:   background: $tabbg;
                   6613:   font-weight: bold;
                   6614:   text-align: right;
                   6615:   width: 184px;
                   6616: }
1.795     www      6617: 
1.424     albertel 6618: table.LC_group_priv_box td.LC_groups_fixed {
                   6619:   background: $data_table_light;
                   6620:   text-align: center;
                   6621: }
1.795     www      6622: 
1.424     albertel 6623: table.LC_group_priv_box td.LC_groups_optional {
                   6624:   background: $data_table_dark;
                   6625:   text-align: center;
                   6626: }
1.795     www      6627: 
1.424     albertel 6628: table.LC_group_priv_box td.LC_groups_functionality {
                   6629:   background: $data_table_darker;
                   6630:   text-align: center;
                   6631:   font-weight: bold;
                   6632: }
1.795     www      6633: 
1.424     albertel 6634: table.LC_group_priv td {
                   6635:   text-align: left;
1.803     bisitz   6636:   padding: 0;
1.424     albertel 6637: }
                   6638: 
                   6639: .LC_navbuttons {
                   6640:   margin: 2ex 0ex 2ex 0ex;
                   6641: }
1.795     www      6642: 
1.423     albertel 6643: .LC_topic_bar {
                   6644:   font-weight: bold;
                   6645:   background: $tabbg;
1.918     wenzelju 6646:   margin: 1em 0em 1em 2em;
1.805     bisitz   6647:   padding: 3px;
1.918     wenzelju 6648:   font-size: 1.2em;
1.423     albertel 6649: }
1.795     www      6650: 
1.423     albertel 6651: .LC_topic_bar span {
1.918     wenzelju 6652:   left: 0.5em;
                   6653:   position: absolute;
1.423     albertel 6654:   vertical-align: middle;
1.918     wenzelju 6655:   font-size: 1.2em;
1.423     albertel 6656: }
1.795     www      6657: 
1.423     albertel 6658: table.LC_course_group_status {
                   6659:   margin: 20px;
                   6660: }
1.795     www      6661: 
1.423     albertel 6662: table.LC_status_selector td {
                   6663:   vertical-align: top;
                   6664:   text-align: center;
1.424     albertel 6665:   padding: 4px;
                   6666: }
1.795     www      6667: 
1.599     albertel 6668: div.LC_feedback_link {
1.616     albertel 6669:   clear: both;
1.829     kalberla 6670:   background: $sidebg;
1.779     bisitz   6671:   width: 100%;
1.829     kalberla 6672:   padding-bottom: 10px;
                   6673:   border: 1px $tabbg solid;
1.833     kalberla 6674:   height: 22px;
                   6675:   line-height: 22px;
                   6676:   padding-top: 5px;
                   6677: }
                   6678: 
                   6679: div.LC_feedback_link img {
                   6680:   height: 22px;
1.867     kalberla 6681:   vertical-align:middle;
1.829     kalberla 6682: }
                   6683: 
1.911     bisitz   6684: div.LC_feedback_link a {
1.829     kalberla 6685:   text-decoration: none;
1.489     raeburn  6686: }
1.795     www      6687: 
1.867     kalberla 6688: div.LC_comblock {
1.911     bisitz   6689:   display:inline;
1.867     kalberla 6690:   color:$font;
                   6691:   font-size:90%;
                   6692: }
                   6693: 
                   6694: div.LC_feedback_link div.LC_comblock {
                   6695:   padding-left:5px;
                   6696: }
                   6697: 
                   6698: div.LC_feedback_link div.LC_comblock a {
                   6699:   color:$font;
                   6700: }
                   6701: 
1.489     raeburn  6702: span.LC_feedback_link {
1.858     bisitz   6703:   /* background: $feedback_link_bg; */
1.599     albertel 6704:   font-size: larger;
                   6705: }
1.795     www      6706: 
1.599     albertel 6707: span.LC_message_link {
1.858     bisitz   6708:   /* background: $feedback_link_bg; */
1.599     albertel 6709:   font-size: larger;
                   6710:   position: absolute;
                   6711:   right: 1em;
1.489     raeburn  6712: }
1.421     albertel 6713: 
1.515     albertel 6714: table.LC_prior_tries {
1.524     albertel 6715:   border: 1px solid #000000;
                   6716:   border-collapse: separate;
                   6717:   border-spacing: 1px;
1.515     albertel 6718: }
1.523     albertel 6719: 
1.515     albertel 6720: table.LC_prior_tries td {
1.524     albertel 6721:   padding: 2px;
1.515     albertel 6722: }
1.523     albertel 6723: 
                   6724: .LC_answer_correct {
1.795     www      6725:   background: lightgreen;
                   6726:   color: darkgreen;
                   6727:   padding: 6px;
1.523     albertel 6728: }
1.795     www      6729: 
1.523     albertel 6730: .LC_answer_charged_try {
1.797     www      6731:   background: #FFAAAA;
1.795     www      6732:   color: darkred;
                   6733:   padding: 6px;
1.523     albertel 6734: }
1.795     www      6735: 
1.779     bisitz   6736: .LC_answer_not_charged_try,
1.523     albertel 6737: .LC_answer_no_grade,
                   6738: .LC_answer_late {
1.795     www      6739:   background: lightyellow;
1.523     albertel 6740:   color: black;
1.795     www      6741:   padding: 6px;
1.523     albertel 6742: }
1.795     www      6743: 
1.523     albertel 6744: .LC_answer_previous {
1.795     www      6745:   background: lightblue;
                   6746:   color: darkblue;
                   6747:   padding: 6px;
1.523     albertel 6748: }
1.795     www      6749: 
1.779     bisitz   6750: .LC_answer_no_message {
1.777     tempelho 6751:   background: #FFFFFF;
                   6752:   color: black;
1.795     www      6753:   padding: 6px;
1.779     bisitz   6754: }
1.795     www      6755: 
1.779     bisitz   6756: .LC_answer_unknown {
                   6757:   background: orange;
                   6758:   color: black;
1.795     www      6759:   padding: 6px;
1.777     tempelho 6760: }
1.795     www      6761: 
1.529     albertel 6762: span.LC_prior_numerical,
                   6763: span.LC_prior_string,
                   6764: span.LC_prior_custom,
                   6765: span.LC_prior_reaction,
                   6766: span.LC_prior_math {
1.925     bisitz   6767:   font-family: $mono;
1.523     albertel 6768:   white-space: pre;
                   6769: }
                   6770: 
1.525     albertel 6771: span.LC_prior_string {
1.925     bisitz   6772:   font-family: $mono;
1.525     albertel 6773:   white-space: pre;
                   6774: }
                   6775: 
1.523     albertel 6776: table.LC_prior_option {
                   6777:   width: 100%;
                   6778:   border-collapse: collapse;
                   6779: }
1.795     www      6780: 
1.911     bisitz   6781: table.LC_prior_rank,
1.795     www      6782: table.LC_prior_match {
1.528     albertel 6783:   border-collapse: collapse;
                   6784: }
1.795     www      6785: 
1.528     albertel 6786: table.LC_prior_option tr td,
                   6787: table.LC_prior_rank tr td,
                   6788: table.LC_prior_match tr td {
1.524     albertel 6789:   border: 1px solid #000000;
1.515     albertel 6790: }
                   6791: 
1.855     bisitz   6792: .LC_nobreak {
1.544     albertel 6793:   white-space: nowrap;
1.519     raeburn  6794: }
                   6795: 
1.576     raeburn  6796: span.LC_cusr_emph {
                   6797:   font-style: italic;
                   6798: }
                   6799: 
1.633     raeburn  6800: span.LC_cusr_subheading {
                   6801:   font-weight: normal;
                   6802:   font-size: 85%;
                   6803: }
                   6804: 
1.861     bisitz   6805: div.LC_docs_entry_move {
1.859     bisitz   6806:   border: 1px solid #BBBBBB;
1.545     albertel 6807:   background: #DDDDDD;
1.861     bisitz   6808:   width: 22px;
1.859     bisitz   6809:   padding: 1px;
                   6810:   margin: 0;
1.545     albertel 6811: }
                   6812: 
1.861     bisitz   6813: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6814: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6815:   font-size: x-small;
                   6816: }
1.795     www      6817: 
1.861     bisitz   6818: .LC_docs_entry_parameter {
                   6819:   white-space: nowrap;
                   6820: }
                   6821: 
1.544     albertel 6822: .LC_docs_copy {
1.545     albertel 6823:   color: #000099;
1.544     albertel 6824: }
1.795     www      6825: 
1.544     albertel 6826: .LC_docs_cut {
1.545     albertel 6827:   color: #550044;
1.544     albertel 6828: }
1.795     www      6829: 
1.544     albertel 6830: .LC_docs_rename {
1.545     albertel 6831:   color: #009900;
1.544     albertel 6832: }
1.795     www      6833: 
1.544     albertel 6834: .LC_docs_remove {
1.545     albertel 6835:   color: #990000;
                   6836: }
                   6837: 
1.1075.2.134  raeburn  6838: .LC_domprefs_email,
1.547     albertel 6839: .LC_docs_reinit_warn,
                   6840: .LC_docs_ext_edit {
                   6841:   font-size: x-small;
                   6842: }
                   6843: 
1.545     albertel 6844: table.LC_docs_adddocs td,
                   6845: table.LC_docs_adddocs th {
                   6846:   border: 1px solid #BBBBBB;
                   6847:   padding: 4px;
                   6848:   background: #DDDDDD;
1.543     albertel 6849: }
                   6850: 
1.584     albertel 6851: table.LC_sty_begin {
                   6852:   background: #BBFFBB;
                   6853: }
1.795     www      6854: 
1.584     albertel 6855: table.LC_sty_end {
                   6856:   background: #FFBBBB;
                   6857: }
                   6858: 
1.589     raeburn  6859: table.LC_double_column {
1.803     bisitz   6860:   border-width: 0;
1.589     raeburn  6861:   border-collapse: collapse;
                   6862:   width: 100%;
                   6863:   padding: 2px;
                   6864: }
                   6865: 
                   6866: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6867:   top: 2px;
1.589     raeburn  6868:   left: 2px;
                   6869:   width: 47%;
                   6870:   vertical-align: top;
                   6871: }
                   6872: 
                   6873: table.LC_double_column tr td.LC_right_col {
                   6874:   top: 2px;
1.779     bisitz   6875:   right: 2px;
1.589     raeburn  6876:   width: 47%;
                   6877:   vertical-align: top;
                   6878: }
                   6879: 
1.591     raeburn  6880: div.LC_left_float {
                   6881:   float: left;
                   6882:   padding-right: 5%;
1.597     albertel 6883:   padding-bottom: 4px;
1.591     raeburn  6884: }
                   6885: 
                   6886: div.LC_clear_float_header {
1.597     albertel 6887:   padding-bottom: 2px;
1.591     raeburn  6888: }
                   6889: 
                   6890: div.LC_clear_float_footer {
1.597     albertel 6891:   padding-top: 10px;
1.591     raeburn  6892:   clear: both;
                   6893: }
                   6894: 
1.597     albertel 6895: div.LC_grade_show_user {
1.941     bisitz   6896: /*  border-left: 5px solid $sidebg; */
                   6897:   border-top: 5px solid #000000;
                   6898:   margin: 50px 0 0 0;
1.936     bisitz   6899:   padding: 15px 0 5px 10px;
1.597     albertel 6900: }
1.795     www      6901: 
1.936     bisitz   6902: div.LC_grade_show_user_odd_row {
1.941     bisitz   6903: /*  border-left: 5px solid #000000; */
                   6904: }
                   6905: 
                   6906: div.LC_grade_show_user div.LC_Box {
                   6907:   margin-right: 50px;
1.597     albertel 6908: }
                   6909: 
                   6910: div.LC_grade_submissions,
                   6911: div.LC_grade_message_center,
1.936     bisitz   6912: div.LC_grade_info_links {
1.597     albertel 6913:   margin: 5px;
                   6914:   width: 99%;
                   6915:   background: #FFFFFF;
                   6916: }
1.795     www      6917: 
1.597     albertel 6918: div.LC_grade_submissions_header,
1.936     bisitz   6919: div.LC_grade_message_center_header {
1.705     tempelho 6920:   font-weight: bold;
                   6921:   font-size: large;
1.597     albertel 6922: }
1.795     www      6923: 
1.597     albertel 6924: div.LC_grade_submissions_body,
1.936     bisitz   6925: div.LC_grade_message_center_body {
1.597     albertel 6926:   border: 1px solid black;
                   6927:   width: 99%;
                   6928:   background: #FFFFFF;
                   6929: }
1.795     www      6930: 
1.613     albertel 6931: table.LC_scantron_action {
                   6932:   width: 100%;
                   6933: }
1.795     www      6934: 
1.613     albertel 6935: table.LC_scantron_action tr th {
1.698     harmsja  6936:   font-weight:bold;
                   6937:   font-style:normal;
1.613     albertel 6938: }
1.795     www      6939: 
1.779     bisitz   6940: .LC_edit_problem_header,
1.614     albertel 6941: div.LC_edit_problem_footer {
1.705     tempelho 6942:   font-weight: normal;
                   6943:   font-size:  medium;
1.602     albertel 6944:   margin: 2px;
1.1060    bisitz   6945:   background-color: $sidebg;
1.600     albertel 6946: }
1.795     www      6947: 
1.600     albertel 6948: div.LC_edit_problem_header,
1.602     albertel 6949: div.LC_edit_problem_header div,
1.614     albertel 6950: div.LC_edit_problem_footer,
                   6951: div.LC_edit_problem_footer div,
1.602     albertel 6952: div.LC_edit_problem_editxml_header,
                   6953: div.LC_edit_problem_editxml_header div {
1.1075.2.112  raeburn  6954:   z-index: 100;
1.600     albertel 6955: }
1.795     www      6956: 
1.600     albertel 6957: div.LC_edit_problem_header_title {
1.705     tempelho 6958:   font-weight: bold;
                   6959:   font-size: larger;
1.602     albertel 6960:   background: $tabbg;
                   6961:   padding: 3px;
1.1060    bisitz   6962:   margin: 0 0 5px 0;
1.602     albertel 6963: }
1.795     www      6964: 
1.602     albertel 6965: table.LC_edit_problem_header_title {
                   6966:   width: 100%;
1.600     albertel 6967:   background: $tabbg;
1.602     albertel 6968: }
                   6969: 
1.1075.2.112  raeburn  6970: div.LC_edit_actionbar {
                   6971:     background-color: $sidebg;
                   6972:     margin: 0;
                   6973:     padding: 0;
                   6974:     line-height: 200%;
1.602     albertel 6975: }
1.795     www      6976: 
1.1075.2.112  raeburn  6977: div.LC_edit_actionbar div{
                   6978:     padding: 0;
                   6979:     margin: 0;
                   6980:     display: inline-block;
1.600     albertel 6981: }
1.795     www      6982: 
1.1075.2.34  raeburn  6983: .LC_edit_opt {
                   6984:   padding-left: 1em;
                   6985:   white-space: nowrap;
                   6986: }
                   6987: 
1.1075.2.57  raeburn  6988: .LC_edit_problem_latexhelper{
                   6989:     text-align: right;
                   6990: }
                   6991: 
                   6992: #LC_edit_problem_colorful div{
                   6993:     margin-left: 40px;
                   6994: }
                   6995: 
1.1075.2.112  raeburn  6996: #LC_edit_problem_codemirror div{
                   6997:     margin-left: 0px;
                   6998: }
                   6999: 
1.911     bisitz   7000: img.stift {
1.803     bisitz   7001:   border-width: 0;
                   7002:   vertical-align: middle;
1.677     riegler  7003: }
1.680     riegler  7004: 
1.923     bisitz   7005: table td.LC_mainmenu_col_fieldset {
1.680     riegler  7006:   vertical-align: top;
1.777     tempelho 7007: }
1.795     www      7008: 
1.716     raeburn  7009: div.LC_createcourse {
1.911     bisitz   7010:   margin: 10px 10px 10px 10px;
1.716     raeburn  7011: }
                   7012: 
1.917     raeburn  7013: .LC_dccid {
1.1075.2.38  raeburn  7014:   float: right;
1.917     raeburn  7015:   margin: 0.2em 0 0 0;
                   7016:   padding: 0;
                   7017:   font-size: 90%;
                   7018:   display:none;
                   7019: }
                   7020: 
1.897     wenzelju 7021: ol.LC_primary_menu a:hover,
1.721     harmsja  7022: ol#LC_MenuBreadcrumbs a:hover,
                   7023: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 7024: ul#LC_secondary_menu a:hover,
1.721     harmsja  7025: .LC_FormSectionClearButton input:hover
1.795     www      7026: ul.LC_TabContent   li:hover a {
1.952     onken    7027:   color:$button_hover;
1.911     bisitz   7028:   text-decoration:none;
1.693     droeschl 7029: }
                   7030: 
1.779     bisitz   7031: h1 {
1.911     bisitz   7032:   padding: 0;
                   7033:   line-height:130%;
1.693     droeschl 7034: }
1.698     harmsja  7035: 
1.911     bisitz   7036: h2,
                   7037: h3,
                   7038: h4,
                   7039: h5,
                   7040: h6 {
                   7041:   margin: 5px 0 5px 0;
                   7042:   padding: 0;
                   7043:   line-height:130%;
1.693     droeschl 7044: }
1.795     www      7045: 
                   7046: .LC_hcell {
1.911     bisitz   7047:   padding:3px 15px 3px 15px;
                   7048:   margin: 0;
                   7049:   background-color:$tabbg;
                   7050:   color:$fontmenu;
                   7051:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 7052: }
1.795     www      7053: 
1.840     bisitz   7054: .LC_Box > .LC_hcell {
1.911     bisitz   7055:   margin: 0 -10px 10px -10px;
1.835     bisitz   7056: }
                   7057: 
1.721     harmsja  7058: .LC_noBorder {
1.911     bisitz   7059:   border: 0;
1.698     harmsja  7060: }
1.693     droeschl 7061: 
1.721     harmsja  7062: .LC_FormSectionClearButton input {
1.911     bisitz   7063:   background-color:transparent;
                   7064:   border: none;
                   7065:   cursor:pointer;
                   7066:   text-decoration:underline;
1.693     droeschl 7067: }
1.763     bisitz   7068: 
                   7069: .LC_help_open_topic {
1.911     bisitz   7070:   color: #FFFFFF;
                   7071:   background-color: #EEEEFF;
                   7072:   margin: 1px;
                   7073:   padding: 4px;
                   7074:   border: 1px solid #000033;
                   7075:   white-space: nowrap;
                   7076:   /* vertical-align: middle; */
1.759     neumanie 7077: }
1.693     droeschl 7078: 
1.911     bisitz   7079: dl,
                   7080: ul,
                   7081: div,
                   7082: fieldset {
                   7083:   margin: 10px 10px 10px 0;
                   7084:   /* overflow: hidden; */
1.693     droeschl 7085: }
1.795     www      7086: 
1.1075.2.90  raeburn  7087: article.geogebraweb div {
                   7088:     margin: 0;
                   7089: }
                   7090: 
1.838     bisitz   7091: fieldset > legend {
1.911     bisitz   7092:   font-weight: bold;
                   7093:   padding: 0 5px 0 5px;
1.838     bisitz   7094: }
                   7095: 
1.813     bisitz   7096: #LC_nav_bar {
1.911     bisitz   7097:   float: left;
1.995     raeburn  7098:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   7099:   margin: 0 0 2px 0;
1.807     droeschl 7100: }
                   7101: 
1.916     droeschl 7102: #LC_realm {
                   7103:   margin: 0.2em 0 0 0;
                   7104:   padding: 0;
                   7105:   font-weight: bold;
                   7106:   text-align: center;
1.995     raeburn  7107:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7108: }
                   7109: 
1.911     bisitz   7110: #LC_nav_bar em {
                   7111:   font-weight: bold;
                   7112:   font-style: normal;
1.807     droeschl 7113: }
                   7114: 
1.897     wenzelju 7115: ol.LC_primary_menu {
1.934     droeschl 7116:   margin: 0;
1.1075.2.2  raeburn  7117:   padding: 0;
1.807     droeschl 7118: }
                   7119: 
1.852     droeschl 7120: ol#LC_PathBreadcrumbs {
1.911     bisitz   7121:   margin: 0;
1.693     droeschl 7122: }
                   7123: 
1.897     wenzelju 7124: ol.LC_primary_menu li {
1.1075.2.2  raeburn  7125:   color: RGB(80, 80, 80);
                   7126:   vertical-align: middle;
                   7127:   text-align: left;
                   7128:   list-style: none;
1.1075.2.112  raeburn  7129:   position: relative;
1.1075.2.2  raeburn  7130:   float: left;
1.1075.2.112  raeburn  7131:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7132:   line-height: 1.5em;
1.1075.2.2  raeburn  7133: }
                   7134: 
1.1075.2.113  raeburn  7135: ol.LC_primary_menu li a, 
1.1075.2.112  raeburn  7136: ol.LC_primary_menu li p {
1.1075.2.2  raeburn  7137:   display: block;
                   7138:   margin: 0;
                   7139:   padding: 0 5px 0 10px;
                   7140:   text-decoration: none;
                   7141: }
                   7142: 
1.1075.2.112  raeburn  7143: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   7144:   display: inline-block;
                   7145:   width: 95%;
                   7146:   text-align: left;
                   7147: }
                   7148: 
                   7149: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   7150:   display: inline-block;
                   7151:   width: 5%;
                   7152:   float: right;
                   7153:   text-align: right;
                   7154:   font-size: 70%;
                   7155: }
                   7156: 
                   7157: ol.LC_primary_menu ul {
1.1075.2.2  raeburn  7158:   display: none;
1.1075.2.112  raeburn  7159:   width: 15em;
1.1075.2.2  raeburn  7160:   background-color: $data_table_light;
1.1075.2.112  raeburn  7161:   position: absolute;
                   7162:   top: 100%;
                   7163: }
                   7164: 
                   7165: ol.LC_primary_menu ul ul {
                   7166:   left: 100%;
                   7167:   top: 0;
1.1075.2.2  raeburn  7168: }
                   7169: 
1.1075.2.112  raeburn  7170: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1075.2.2  raeburn  7171:   display: block;
                   7172:   position: absolute;
                   7173:   margin: 0;
                   7174:   padding: 0;
1.1075.2.5  raeburn  7175:   z-index: 2;
1.1075.2.2  raeburn  7176: }
                   7177: 
                   7178: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1075.2.112  raeburn  7179: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1075.2.2  raeburn  7180:   font-size: 90%;
1.911     bisitz   7181:   vertical-align: top;
1.1075.2.2  raeburn  7182:   float: none;
1.1075.2.5  raeburn  7183:   border-left: 1px solid black;
                   7184:   border-right: 1px solid black;
1.1075.2.112  raeburn  7185: /* A dark bottom border to visualize different menu options;
                   7186: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   7187:   border-bottom: 1px solid $data_table_dark;
1.1075.2.2  raeburn  7188: }
                   7189: 
1.1075.2.112  raeburn  7190: ol.LC_primary_menu li li p:hover {
                   7191:   color:$button_hover;
                   7192:   text-decoration:none;
                   7193:   background-color:$data_table_dark;
1.1075.2.2  raeburn  7194: }
                   7195: 
                   7196: ol.LC_primary_menu li li a:hover {
                   7197:    color:$button_hover;
                   7198:    background-color:$data_table_dark;
1.693     droeschl 7199: }
                   7200: 
1.1075.2.112  raeburn  7201: /* Font-size equal to the size of the predecessors*/
                   7202: ol.LC_primary_menu li:hover li li {
                   7203:   font-size: 100%;
                   7204: }
                   7205: 
1.897     wenzelju 7206: ol.LC_primary_menu li img {
1.911     bisitz   7207:   vertical-align: bottom;
1.934     droeschl 7208:   height: 1.1em;
1.1075.2.3  raeburn  7209:   margin: 0.2em 0 0 0;
1.693     droeschl 7210: }
                   7211: 
1.897     wenzelju 7212: ol.LC_primary_menu a {
1.911     bisitz   7213:   color: RGB(80, 80, 80);
                   7214:   text-decoration: none;
1.693     droeschl 7215: }
1.795     www      7216: 
1.949     droeschl 7217: ol.LC_primary_menu a.LC_new_message {
                   7218:   font-weight:bold;
                   7219:   color: darkred;
                   7220: }
                   7221: 
1.975     raeburn  7222: ol.LC_docs_parameters {
                   7223:   margin-left: 0;
                   7224:   padding: 0;
                   7225:   list-style: none;
                   7226: }
                   7227: 
                   7228: ol.LC_docs_parameters li {
                   7229:   margin: 0;
                   7230:   padding-right: 20px;
                   7231:   display: inline;
                   7232: }
                   7233: 
1.976     raeburn  7234: ol.LC_docs_parameters li:before {
                   7235:   content: "\\002022 \\0020";
                   7236: }
                   7237: 
                   7238: li.LC_docs_parameters_title {
                   7239:   font-weight: bold;
                   7240: }
                   7241: 
                   7242: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   7243:   content: "";
                   7244: }
                   7245: 
1.897     wenzelju 7246: ul#LC_secondary_menu {
1.1075.2.23  raeburn  7247:   clear: right;
1.911     bisitz   7248:   color: $fontmenu;
                   7249:   background: $tabbg;
                   7250:   list-style: none;
                   7251:   padding: 0;
                   7252:   margin: 0;
                   7253:   width: 100%;
1.995     raeburn  7254:   text-align: left;
1.1075.2.4  raeburn  7255:   float: left;
1.808     droeschl 7256: }
                   7257: 
1.897     wenzelju 7258: ul#LC_secondary_menu li {
1.911     bisitz   7259:   font-weight: bold;
                   7260:   line-height: 1.8em;
                   7261:   border-right: 1px solid black;
1.1075.2.4  raeburn  7262:   float: left;
                   7263: }
                   7264: 
                   7265: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   7266:   background-color: $data_table_light;
                   7267: }
                   7268: 
                   7269: ul#LC_secondary_menu li a {
                   7270:   padding: 0 0.8em;
                   7271: }
                   7272: 
                   7273: ul#LC_secondary_menu li ul {
                   7274:   display: none;
                   7275: }
                   7276: 
                   7277: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   7278:   display: block;
                   7279:   position: absolute;
                   7280:   margin: 0;
                   7281:   padding: 0;
                   7282:   list-style:none;
                   7283:   float: none;
                   7284:   background-color: $data_table_light;
1.1075.2.5  raeburn  7285:   z-index: 2;
1.1075.2.10  raeburn  7286:   margin-left: -1px;
1.1075.2.4  raeburn  7287: }
                   7288: 
                   7289: ul#LC_secondary_menu li ul li {
                   7290:   font-size: 90%;
                   7291:   vertical-align: top;
                   7292:   border-left: 1px solid black;
                   7293:   border-right: 1px solid black;
1.1075.2.33  raeburn  7294:   background-color: $data_table_light;
1.1075.2.4  raeburn  7295:   list-style:none;
                   7296:   float: none;
                   7297: }
                   7298: 
                   7299: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   7300:   background-color: $data_table_dark;
1.807     droeschl 7301: }
                   7302: 
1.847     tempelho 7303: ul.LC_TabContent {
1.911     bisitz   7304:   display:block;
                   7305:   background: $sidebg;
                   7306:   border-bottom: solid 1px $lg_border_color;
                   7307:   list-style:none;
1.1020    raeburn  7308:   margin: -1px -10px 0 -10px;
1.911     bisitz   7309:   padding: 0;
1.693     droeschl 7310: }
                   7311: 
1.795     www      7312: ul.LC_TabContent li,
                   7313: ul.LC_TabContentBigger li {
1.911     bisitz   7314:   float:left;
1.741     harmsja  7315: }
1.795     www      7316: 
1.897     wenzelju 7317: ul#LC_secondary_menu li a {
1.911     bisitz   7318:   color: $fontmenu;
                   7319:   text-decoration: none;
1.693     droeschl 7320: }
1.795     www      7321: 
1.721     harmsja  7322: ul.LC_TabContent {
1.952     onken    7323:   min-height:20px;
1.721     harmsja  7324: }
1.795     www      7325: 
                   7326: ul.LC_TabContent li {
1.911     bisitz   7327:   vertical-align:middle;
1.959     onken    7328:   padding: 0 16px 0 10px;
1.911     bisitz   7329:   background-color:$tabbg;
                   7330:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  7331:   border-left: solid 1px $font;
1.721     harmsja  7332: }
1.795     www      7333: 
1.847     tempelho 7334: ul.LC_TabContent .right {
1.911     bisitz   7335:   float:right;
1.847     tempelho 7336: }
                   7337: 
1.911     bisitz   7338: ul.LC_TabContent li a,
                   7339: ul.LC_TabContent li {
                   7340:   color:rgb(47,47,47);
                   7341:   text-decoration:none;
                   7342:   font-size:95%;
                   7343:   font-weight:bold;
1.952     onken    7344:   min-height:20px;
                   7345: }
                   7346: 
1.959     onken    7347: ul.LC_TabContent li a:hover,
                   7348: ul.LC_TabContent li a:focus {
1.952     onken    7349:   color: $button_hover;
1.959     onken    7350:   background:none;
                   7351:   outline:none;
1.952     onken    7352: }
                   7353: 
                   7354: ul.LC_TabContent li:hover {
                   7355:   color: $button_hover;
                   7356:   cursor:pointer;
1.721     harmsja  7357: }
1.795     www      7358: 
1.911     bisitz   7359: ul.LC_TabContent li.active {
1.952     onken    7360:   color: $font;
1.911     bisitz   7361:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    7362:   border-bottom:solid 1px #FFFFFF;
                   7363:   cursor: default;
1.744     ehlerst  7364: }
1.795     www      7365: 
1.959     onken    7366: ul.LC_TabContent li.active a {
                   7367:   color:$font;
                   7368:   background:#FFFFFF;
                   7369:   outline: none;
                   7370: }
1.1047    raeburn  7371: 
                   7372: ul.LC_TabContent li.goback {
                   7373:   float: left;
                   7374:   border-left: none;
                   7375: }
                   7376: 
1.870     tempelho 7377: #maincoursedoc {
1.911     bisitz   7378:   clear:both;
1.870     tempelho 7379: }
                   7380: 
                   7381: ul.LC_TabContentBigger {
1.911     bisitz   7382:   display:block;
                   7383:   list-style:none;
                   7384:   padding: 0;
1.870     tempelho 7385: }
                   7386: 
1.795     www      7387: ul.LC_TabContentBigger li {
1.911     bisitz   7388:   vertical-align:bottom;
                   7389:   height: 30px;
                   7390:   font-size:110%;
                   7391:   font-weight:bold;
                   7392:   color: #737373;
1.841     tempelho 7393: }
                   7394: 
1.957     onken    7395: ul.LC_TabContentBigger li.active {
                   7396:   position: relative;
                   7397:   top: 1px;
                   7398: }
                   7399: 
1.870     tempelho 7400: ul.LC_TabContentBigger li a {
1.911     bisitz   7401:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   7402:   height: 30px;
                   7403:   line-height: 30px;
                   7404:   text-align: center;
                   7405:   display: block;
                   7406:   text-decoration: none;
1.958     onken    7407:   outline: none;  
1.741     harmsja  7408: }
1.795     www      7409: 
1.870     tempelho 7410: ul.LC_TabContentBigger li.active a {
1.911     bisitz   7411:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   7412:   color:$font;
1.744     ehlerst  7413: }
1.795     www      7414: 
1.870     tempelho 7415: ul.LC_TabContentBigger li b {
1.911     bisitz   7416:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7417:   display: block;
                   7418:   float: left;
                   7419:   padding: 0 30px;
1.957     onken    7420:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7421: }
                   7422: 
1.956     onken    7423: ul.LC_TabContentBigger li:hover b {
                   7424:   color:$button_hover;
                   7425: }
                   7426: 
1.870     tempelho 7427: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7428:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7429:   color:$font;
1.957     onken    7430:   border: 0;
1.741     harmsja  7431: }
1.693     droeschl 7432: 
1.870     tempelho 7433: 
1.862     bisitz   7434: ul.LC_CourseBreadcrumbs {
                   7435:   background: $sidebg;
1.1020    raeburn  7436:   height: 2em;
1.862     bisitz   7437:   padding-left: 10px;
1.1020    raeburn  7438:   margin: 0;
1.862     bisitz   7439:   list-style-position: inside;
                   7440: }
                   7441: 
1.911     bisitz   7442: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7443: ol#LC_PathBreadcrumbs {
1.911     bisitz   7444:   padding-left: 10px;
                   7445:   margin: 0;
1.933     droeschl 7446:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7447: }
                   7448: 
1.911     bisitz   7449: ol#LC_MenuBreadcrumbs li,
                   7450: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7451: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7452:   display: inline;
1.933     droeschl 7453:   white-space: normal;  
1.693     droeschl 7454: }
                   7455: 
1.823     bisitz   7456: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7457: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7458:   text-decoration: none;
                   7459:   font-size:90%;
1.693     droeschl 7460: }
1.795     www      7461: 
1.969     droeschl 7462: ol#LC_MenuBreadcrumbs h1 {
                   7463:   display: inline;
                   7464:   font-size: 90%;
                   7465:   line-height: 2.5em;
                   7466:   margin: 0;
                   7467:   padding: 0;
                   7468: }
                   7469: 
1.795     www      7470: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7471:   text-decoration:none;
                   7472:   font-size:100%;
                   7473:   font-weight:bold;
1.693     droeschl 7474: }
1.795     www      7475: 
1.840     bisitz   7476: .LC_Box {
1.911     bisitz   7477:   border: solid 1px $lg_border_color;
                   7478:   padding: 0 10px 10px 10px;
1.746     neumanie 7479: }
1.795     www      7480: 
1.1020    raeburn  7481: .LC_DocsBox {
                   7482:   border: solid 1px $lg_border_color;
                   7483:   padding: 0 0 10px 10px;
                   7484: }
                   7485: 
1.795     www      7486: .LC_AboutMe_Image {
1.911     bisitz   7487:   float:left;
                   7488:   margin-right:10px;
1.747     neumanie 7489: }
1.795     www      7490: 
                   7491: .LC_Clear_AboutMe_Image {
1.911     bisitz   7492:   clear:left;
1.747     neumanie 7493: }
1.795     www      7494: 
1.721     harmsja  7495: dl.LC_ListStyleClean dt {
1.911     bisitz   7496:   padding-right: 5px;
                   7497:   display: table-header-group;
1.693     droeschl 7498: }
                   7499: 
1.721     harmsja  7500: dl.LC_ListStyleClean dd {
1.911     bisitz   7501:   display: table-row;
1.693     droeschl 7502: }
                   7503: 
1.721     harmsja  7504: .LC_ListStyleClean,
                   7505: .LC_ListStyleSimple,
                   7506: .LC_ListStyleNormal,
1.795     www      7507: .LC_ListStyleSpecial {
1.911     bisitz   7508:   /* display:block; */
                   7509:   list-style-position: inside;
                   7510:   list-style-type: none;
                   7511:   overflow: hidden;
                   7512:   padding: 0;
1.693     droeschl 7513: }
                   7514: 
1.721     harmsja  7515: .LC_ListStyleSimple li,
                   7516: .LC_ListStyleSimple dd,
                   7517: .LC_ListStyleNormal li,
                   7518: .LC_ListStyleNormal dd,
                   7519: .LC_ListStyleSpecial li,
1.795     www      7520: .LC_ListStyleSpecial dd {
1.911     bisitz   7521:   margin: 0;
                   7522:   padding: 5px 5px 5px 10px;
                   7523:   clear: both;
1.693     droeschl 7524: }
                   7525: 
1.721     harmsja  7526: .LC_ListStyleClean li,
                   7527: .LC_ListStyleClean dd {
1.911     bisitz   7528:   padding-top: 0;
                   7529:   padding-bottom: 0;
1.693     droeschl 7530: }
                   7531: 
1.721     harmsja  7532: .LC_ListStyleSimple dd,
1.795     www      7533: .LC_ListStyleSimple li {
1.911     bisitz   7534:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7535: }
                   7536: 
1.721     harmsja  7537: .LC_ListStyleSpecial li,
                   7538: .LC_ListStyleSpecial dd {
1.911     bisitz   7539:   list-style-type: none;
                   7540:   background-color: RGB(220, 220, 220);
                   7541:   margin-bottom: 4px;
1.693     droeschl 7542: }
                   7543: 
1.721     harmsja  7544: table.LC_SimpleTable {
1.911     bisitz   7545:   margin:5px;
                   7546:   border:solid 1px $lg_border_color;
1.795     www      7547: }
1.693     droeschl 7548: 
1.721     harmsja  7549: table.LC_SimpleTable tr {
1.911     bisitz   7550:   padding: 0;
                   7551:   border:solid 1px $lg_border_color;
1.693     droeschl 7552: }
1.795     www      7553: 
                   7554: table.LC_SimpleTable thead {
1.911     bisitz   7555:   background:rgb(220,220,220);
1.693     droeschl 7556: }
                   7557: 
1.721     harmsja  7558: div.LC_columnSection {
1.911     bisitz   7559:   display: block;
                   7560:   clear: both;
                   7561:   overflow: hidden;
                   7562:   margin: 0;
1.693     droeschl 7563: }
                   7564: 
1.721     harmsja  7565: div.LC_columnSection>* {
1.911     bisitz   7566:   float: left;
                   7567:   margin: 10px 20px 10px 0;
                   7568:   overflow:hidden;
1.693     droeschl 7569: }
1.721     harmsja  7570: 
1.795     www      7571: table em {
1.911     bisitz   7572:   font-weight: bold;
                   7573:   font-style: normal;
1.748     schulted 7574: }
1.795     www      7575: 
1.779     bisitz   7576: table.LC_tableBrowseRes,
1.795     www      7577: table.LC_tableOfContent {
1.911     bisitz   7578:   border:none;
                   7579:   border-spacing: 1px;
                   7580:   padding: 3px;
                   7581:   background-color: #FFFFFF;
                   7582:   font-size: 90%;
1.753     droeschl 7583: }
1.789     droeschl 7584: 
1.911     bisitz   7585: table.LC_tableOfContent {
                   7586:   border-collapse: collapse;
1.789     droeschl 7587: }
                   7588: 
1.771     droeschl 7589: table.LC_tableBrowseRes a,
1.768     schulted 7590: table.LC_tableOfContent a {
1.911     bisitz   7591:   background-color: transparent;
                   7592:   text-decoration: none;
1.753     droeschl 7593: }
                   7594: 
1.795     www      7595: table.LC_tableOfContent img {
1.911     bisitz   7596:   border: none;
                   7597:   height: 1.3em;
                   7598:   vertical-align: text-bottom;
                   7599:   margin-right: 0.3em;
1.753     droeschl 7600: }
1.757     schulted 7601: 
1.795     www      7602: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7603:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7604: }
                   7605: 
1.795     www      7606: a#LC_content_toolbar_everything {
1.911     bisitz   7607:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7608: }
                   7609: 
1.795     www      7610: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7611:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7612: }
                   7613: 
1.795     www      7614: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7615:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7616: }
                   7617: 
1.795     www      7618: a#LC_content_toolbar_changefolder {
1.911     bisitz   7619:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7620: }
                   7621: 
1.795     www      7622: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7623:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7624: }
                   7625: 
1.1043    raeburn  7626: a#LC_content_toolbar_edittoplevel {
                   7627:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7628: }
                   7629: 
1.795     www      7630: ul#LC_toolbar li a:hover {
1.911     bisitz   7631:   background-position: bottom center;
1.757     schulted 7632: }
                   7633: 
1.795     www      7634: ul#LC_toolbar {
1.911     bisitz   7635:   padding: 0;
                   7636:   margin: 2px;
                   7637:   list-style:none;
                   7638:   position:relative;
                   7639:   background-color:white;
1.1075.2.9  raeburn  7640:   overflow: auto;
1.757     schulted 7641: }
                   7642: 
1.795     www      7643: ul#LC_toolbar li {
1.911     bisitz   7644:   border:1px solid white;
                   7645:   padding: 0;
                   7646:   margin: 0;
                   7647:   float: left;
                   7648:   display:inline;
                   7649:   vertical-align:middle;
1.1075.2.9  raeburn  7650:   white-space: nowrap;
1.911     bisitz   7651: }
1.757     schulted 7652: 
1.783     amueller 7653: 
1.795     www      7654: a.LC_toolbarItem {
1.911     bisitz   7655:   display:block;
                   7656:   padding: 0;
                   7657:   margin: 0;
                   7658:   height: 32px;
                   7659:   width: 32px;
                   7660:   color:white;
                   7661:   border: none;
                   7662:   background-repeat:no-repeat;
                   7663:   background-color:transparent;
1.757     schulted 7664: }
                   7665: 
1.915     droeschl 7666: ul.LC_funclist {
                   7667:     margin: 0;
                   7668:     padding: 0.5em 1em 0.5em 0;
                   7669: }
                   7670: 
1.933     droeschl 7671: ul.LC_funclist > li:first-child {
                   7672:     font-weight:bold; 
                   7673:     margin-left:0.8em;
                   7674: }
                   7675: 
1.915     droeschl 7676: ul.LC_funclist + ul.LC_funclist {
                   7677:     /* 
                   7678:        left border as a seperator if we have more than
                   7679:        one list 
                   7680:     */
                   7681:     border-left: 1px solid $sidebg;
                   7682:     /* 
                   7683:        this hides the left border behind the border of the 
                   7684:        outer box if element is wrapped to the next 'line' 
                   7685:     */
                   7686:     margin-left: -1px;
                   7687: }
                   7688: 
1.843     bisitz   7689: ul.LC_funclist li {
1.915     droeschl 7690:   display: inline;
1.782     bisitz   7691:   white-space: nowrap;
1.915     droeschl 7692:   margin: 0 0 0 25px;
                   7693:   line-height: 150%;
1.782     bisitz   7694: }
                   7695: 
1.974     wenzelju 7696: .LC_hidden {
                   7697:   display: none;
                   7698: }
                   7699: 
1.1030    www      7700: .LCmodal-overlay {
                   7701: 		position:fixed;
                   7702: 		top:0;
                   7703: 		right:0;
                   7704: 		bottom:0;
                   7705: 		left:0;
                   7706: 		height:100%;
                   7707: 		width:100%;
                   7708: 		margin:0;
                   7709: 		padding:0;
                   7710: 		background:#999;
                   7711: 		opacity:.75;
                   7712: 		filter: alpha(opacity=75);
                   7713: 		-moz-opacity: 0.75;
                   7714: 		z-index:101;
                   7715: }
                   7716: 
                   7717: * html .LCmodal-overlay {   
                   7718: 		position: absolute;
                   7719: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7720: }
                   7721: 
                   7722: .LCmodal-window {
                   7723: 		position:fixed;
                   7724: 		top:50%;
                   7725: 		left:50%;
                   7726: 		margin:0;
                   7727: 		padding:0;
                   7728: 		z-index:102;
                   7729: 	}
                   7730: 
                   7731: * html .LCmodal-window {
                   7732: 		position:absolute;
                   7733: }
                   7734: 
                   7735: .LCclose-window {
                   7736: 		position:absolute;
                   7737: 		width:32px;
                   7738: 		height:32px;
                   7739: 		right:8px;
                   7740: 		top:8px;
                   7741: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7742: 		text-indent:-99999px;
                   7743: 		overflow:hidden;
                   7744: 		cursor:pointer;
                   7745: }
                   7746: 
1.1075.2.17  raeburn  7747: /*
                   7748:   styles used by TTH when "Default set of options to pass to tth/m
                   7749:   when converting TeX" in course settings has been set
                   7750: 
                   7751:   option passed: -t
                   7752: 
                   7753: */
                   7754: 
                   7755: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7756: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7757: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7758: td div.norm {line-height:normal;}
                   7759: 
                   7760: /*
                   7761:   option passed -y3
                   7762: */
                   7763: 
                   7764: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7765: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7766: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7767: 
1.1075.2.121  raeburn  7768: #LC_minitab_header {
                   7769:   float:left;
                   7770:   width:100%;
                   7771:   background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
                   7772:   font-size:93%;
                   7773:   line-height:normal;
                   7774:   margin: 0.5em 0 0.5em 0;
                   7775: }
                   7776: #LC_minitab_header ul {
                   7777:   margin:0;
                   7778:   padding:10px 10px 0;
                   7779:   list-style:none;
                   7780: }
                   7781: #LC_minitab_header li {
                   7782:   float:left;
                   7783:   background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
                   7784:   margin:0;
                   7785:   padding:0 0 0 9px;
                   7786: }
                   7787: #LC_minitab_header a {
                   7788:   display:block;
                   7789:   background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
                   7790:   padding:5px 15px 4px 6px;
                   7791: }
                   7792: #LC_minitab_header #LC_current_minitab {
                   7793:   background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
                   7794: }
                   7795: #LC_minitab_header #LC_current_minitab a {
                   7796:   background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
                   7797:   padding-bottom:5px;
                   7798: }
                   7799: 
                   7800: 
1.343     albertel 7801: END
                   7802: }
                   7803: 
1.306     albertel 7804: =pod
                   7805: 
                   7806: =item * &headtag()
                   7807: 
                   7808: Returns a uniform footer for LON-CAPA web pages.
                   7809: 
1.307     albertel 7810: Inputs: $title - optional title for the head
                   7811:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7812:         $args - optional arguments
1.319     albertel 7813:             force_register - if is true call registerurl so the remote is 
                   7814:                              informed
1.415     albertel 7815:             redirect       -> array ref of
                   7816:                                    1- seconds before redirect occurs
                   7817:                                    2- url to redirect to
                   7818:                                    3- whether the side effect should occur
1.315     albertel 7819:                            (side effect of setting 
                   7820:                                $env{'internal.head.redirect'} to the url 
                   7821:                                redirected too)
1.352     albertel 7822:             domain         -> force to color decorate a page for a specific
                   7823:                                domain
                   7824:             function       -> force usage of a specific rolish color scheme
                   7825:             bgcolor        -> override the default page bgcolor
1.460     albertel 7826:             no_auto_mt_title
                   7827:                            -> prevent &mt()ing the title arg
1.464     albertel 7828: 
1.306     albertel 7829: =cut
                   7830: 
                   7831: sub headtag {
1.313     albertel 7832:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7833:     
1.363     albertel 7834:     my $function = $args->{'function'} || &get_users_function();
                   7835:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7836:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  7837:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7838:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7839: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7840: 		   #time(),
1.418     albertel 7841: 		   $env{'environment.color.timestamp'},
1.363     albertel 7842: 		   $function,$domain,$bgcolor);
                   7843: 
1.369     www      7844:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7845: 
1.308     albertel 7846:     my $result =
                   7847: 	'<head>'.
1.1075.2.56  raeburn  7848: 	&font_settings($args);
1.319     albertel 7849: 
1.1075.2.72  raeburn  7850:     my $inhibitprint;
                   7851:     if ($args->{'print_suppress'}) {
                   7852:         $inhibitprint = &print_suppression();
                   7853:     }
1.1064    raeburn  7854: 
1.461     albertel 7855:     if (!$args->{'frameset'}) {
                   7856: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7857:     }
1.1075.2.12  raeburn  7858:     if ($args->{'force_register'}) {
                   7859:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7860:     }
1.436     albertel 7861:     if (!$args->{'no_nav_bar'} 
                   7862: 	&& !$args->{'only_body'}
                   7863: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  7864: 	$result .= &help_menu_js($httphost);
1.1032    www      7865:         $result.=&modal_window();
1.1038    www      7866:         $result.=&togglebox_script();
1.1034    www      7867:         $result.=&wishlist_window();
1.1041    www      7868:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7869:     } else {
                   7870:         if ($args->{'add_modal'}) {
                   7871:            $result.=&modal_window();
                   7872:         }
                   7873:         if ($args->{'add_wishlist'}) {
                   7874:            $result.=&wishlist_window();
                   7875:         }
1.1038    www      7876:         if ($args->{'add_togglebox'}) {
                   7877:            $result.=&togglebox_script();
                   7878:         }
1.1041    www      7879:         if ($args->{'add_progressbar'}) {
                   7880:            $result.=&LCprogressbarUpdate_script();
                   7881:         }
1.436     albertel 7882:     }
1.314     albertel 7883:     if (ref($args->{'redirect'})) {
1.414     albertel 7884: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7885: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7886: 	if (!$inhibit_continue) {
                   7887: 	    $env{'internal.head.redirect'} = $url;
                   7888: 	}
1.313     albertel 7889: 	$result.=<<ADDMETA
                   7890: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7891: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7892: ADDMETA
1.1075.2.89  raeburn  7893:     } else {
                   7894:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   7895:             my $requrl = $env{'request.uri'};
                   7896:             if ($requrl eq '') {
                   7897:                 $requrl = $ENV{'REQUEST_URI'};
                   7898:                 $requrl =~ s/\?.+$//;
                   7899:             }
                   7900:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   7901:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   7902:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   7903:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   7904:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   7905:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                   7906:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   7907:                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   7908:                         if ($domdefs{'offloadnow'}{$lonhost}) {
                   7909:                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                   7910:                             if (($newserver) && ($newserver ne $lonhost)) {
                   7911:                                 my $numsec = 5;
                   7912:                                 my $timeout = $numsec * 1000;
                   7913:                                 my ($newurl,$locknum,%locks,$msg);
                   7914:                                 if ($env{'request.role.adv'}) {
                   7915:                                     ($locknum,%locks) = &Apache::lonnet::get_locks();
                   7916:                                 }
                   7917:                                 my $disable_submit = 0;
                   7918:                                 if ($requrl =~ /$LONCAPA::assess_re/) {
                   7919:                                     $disable_submit = 1;
                   7920:                                 }
                   7921:                                 if ($locknum) {
                   7922:                                     my @lockinfo = sort(values(%locks));
                   7923:                                     $msg = &mt('Once the following tasks are complete: ')."\\n".
                   7924:                                            join(", ",sort(values(%locks)))."\\n".
                   7925:                                            &mt('your session will be transferred to a different server, after you click "Roles".');
                   7926:                                 } else {
                   7927:                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   7928:                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                   7929:                                     }
                   7930:                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   7931:                                     $newurl = '/adm/switchserver?otherserver='.$newserver;
                   7932:                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   7933:                                         $newurl .= '&role='.$env{'request.role'};
                   7934:                                     }
                   7935:                                     if ($env{'request.symb'}) {
                   7936:                                         $newurl .= '&symb='.$env{'request.symb'};
                   7937:                                     } else {
                   7938:                                         $newurl .= '&origurl='.$requrl;
                   7939:                                     }
                   7940:                                 }
1.1075.2.98  raeburn  7941:                                 &js_escape(\$msg);
1.1075.2.89  raeburn  7942:                                 $result.=<<OFFLOAD
                   7943: <meta http-equiv="pragma" content="no-cache" />
                   7944: <script type="text/javascript">
1.1075.2.92  raeburn  7945: // <![CDATA[
1.1075.2.89  raeburn  7946: function LC_Offload_Now() {
                   7947:     var dest = "$newurl";
                   7948:     if (dest != '') {
                   7949:         window.location.href="$newurl";
                   7950:     }
                   7951: }
1.1075.2.92  raeburn  7952: \$(document).ready(function () {
                   7953:     window.alert('$msg');
                   7954:     if ($disable_submit) {
1.1075.2.89  raeburn  7955:         \$(".LC_hwk_submit").prop("disabled", true);
                   7956:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92  raeburn  7957:     }
                   7958:     setTimeout('LC_Offload_Now()', $timeout);
                   7959: });
                   7960: // ]]>
1.1075.2.89  raeburn  7961: </script>
                   7962: OFFLOAD
                   7963:                             }
                   7964:                         }
                   7965:                     }
                   7966:                 }
                   7967:             }
                   7968:         }
1.313     albertel 7969:     }
1.306     albertel 7970:     if (!defined($title)) {
                   7971: 	$title = 'The LearningOnline Network with CAPA';
                   7972:     }
1.460     albertel 7973:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7974:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  7975: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7976:     if (!$args->{'frameset'}) {
                   7977:         $result .= ' /';
                   7978:     }
                   7979:     $result .= '>'
1.1064    raeburn  7980:         .$inhibitprint
1.414     albertel 7981: 	.$head_extra;
1.1075.2.108  raeburn  7982:     my $clientmobile;
                   7983:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   7984:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   7985:     } else {
                   7986:         $clientmobile = $env{'browser.mobile'};
                   7987:     }
                   7988:     if ($clientmobile) {
1.1075.2.42  raeburn  7989:         $result .= '
                   7990: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7991: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7992:     }
1.1075.2.126  raeburn  7993:     $result .= '<meta name="google" content="notranslate" />'."\n";
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.1075.2.56  raeburn  8003: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 8004: 
                   8005: =cut
                   8006: 
                   8007: sub font_settings {
1.1075.2.56  raeburn  8008:     my ($args) = @_;
1.340     albertel 8009:     my $headerstring='';
1.1075.2.56  raeburn  8010:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   8011:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 8012: 	$headerstring.=
1.1075.2.61  raeburn  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.1075.2.73  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.1075.2.61  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.1075.2.61  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.1075.2.61  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.1075.2.12  raeburn  8170:              no_inline_link -> if true and in remote mode, don't show the
                   8171:                                     'Switch To Inline Menu' link
1.648     raeburn  8172:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 8173:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  8174:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.123  raeburn  8175:              bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                   8176:                                     to lonhtmlcommon::breadcrumbs
1.1075.2.15  raeburn  8177:              group          -> includes the current group, if page is for a
                   8178:                                specific group
1.1075.2.133  raeburn  8179:              use_absolute   -> for request for external resource or syllabus, this
                   8180:                                will contain https://<hostname> if server uses
                   8181:                                https (as per hosts.tab), but request is for http
                   8182:              hostname       -> hostname, originally from $r->hostname(), (optional).
1.361     albertel 8183: 
1.648     raeburn  8184: =back
1.460     albertel 8185: 
1.648     raeburn  8186: =back
1.562     albertel 8187: 
1.306     albertel 8188: =cut
                   8189: 
                   8190: sub start_page {
1.309     albertel 8191:     my ($title,$head_extra,$args) = @_;
1.318     albertel 8192:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 8193: 
1.315     albertel 8194:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  8195:     my ($result,@advtools);
1.964     droeschl 8196: 
1.338     albertel 8197:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  8198:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 8199:     }
                   8200:     
                   8201:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   8202: 	if ($args->{'frameset'}) {
                   8203: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   8204: 						$args->{'add_entries'});
                   8205: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   8206:         } else {
                   8207:             $result .=
                   8208:                 &bodytag($title, 
                   8209:                          $args->{'function'},       $args->{'add_entries'},
                   8210:                          $args->{'only_body'},      $args->{'domain'},
                   8211:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  8212:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  8213:                          $args,                     \@advtools);
1.831     bisitz   8214:         }
1.330     albertel 8215:     }
1.338     albertel 8216: 
1.315     albertel 8217:     if ($args->{'js_ready'}) {
1.713     kaisler  8218: 		$result = &js_ready($result);
1.315     albertel 8219:     }
1.320     albertel 8220:     if ($args->{'html_encode'}) {
1.713     kaisler  8221: 		$result = &html_encode($result);
                   8222:     }
                   8223: 
1.813     bisitz   8224:     # Preparation for new and consistent functionlist at top of screen
                   8225:     # if ($args->{'functionlist'}) {
                   8226:     #            $result .= &build_functionlist();
                   8227:     #}
                   8228: 
1.964     droeschl 8229:     # Don't add anything more if only_body wanted or in const space
                   8230:     return $result if    $args->{'only_body'} 
                   8231:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   8232: 
                   8233:     #Breadcrumbs
1.758     kaisler  8234:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   8235: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   8236: 		#if any br links exists, add them to the breadcrumbs
                   8237: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   8238: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   8239: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   8240: 			}
                   8241: 		}
1.1075.2.19  raeburn  8242:                 # if @advtools array contains items add then to the breadcrumbs
                   8243:                 if (@advtools > 0) {
                   8244:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   8245:                 }
1.1075.2.123  raeburn  8246:                 my $menulink;
                   8247:                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                   8248:                 if (exists($args->{'bread_crumbs_nomenu'})) {
                   8249:                     $menulink = 0;
                   8250:                 } else {
                   8251:                     undef($menulink);
                   8252:                 }
1.758     kaisler  8253: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   8254: 		if(exists($args->{'bread_crumbs_component'})){
1.1075.2.123  raeburn  8255: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.758     kaisler  8256: 		}else{
1.1075.2.123  raeburn  8257: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758     kaisler  8258: 		}
1.1075.2.24  raeburn  8259:     } elsif (($env{'environment.remote'} eq 'on') &&
                   8260:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   8261:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   8262:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  8263:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 8264:     }
1.315     albertel 8265:     return $result;
1.306     albertel 8266: }
                   8267: 
                   8268: sub end_page {
1.315     albertel 8269:     my ($args) = @_;
                   8270:     $env{'internal.end_page'}++;
1.330     albertel 8271:     my $result;
1.335     albertel 8272:     if ($args->{'discussion'}) {
                   8273: 	my ($target,$parser);
                   8274: 	if (ref($args->{'discussion'})) {
                   8275: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   8276: 				$args->{'discussion'}{'parser'});
                   8277: 	}
                   8278: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   8279:     }
1.330     albertel 8280:     if ($args->{'frameset'}) {
                   8281: 	$result .= '</frameset>';
                   8282:     } else {
1.635     raeburn  8283: 	$result .= &endbodytag($args);
1.330     albertel 8284:     }
1.1075.2.6  raeburn  8285:     unless ($args->{'notbody'}) {
                   8286:         $result .= "\n</html>";
                   8287:     }
1.330     albertel 8288: 
1.315     albertel 8289:     if ($args->{'js_ready'}) {
1.317     albertel 8290: 	$result = &js_ready($result);
1.315     albertel 8291:     }
1.335     albertel 8292: 
1.320     albertel 8293:     if ($args->{'html_encode'}) {
                   8294: 	$result = &html_encode($result);
                   8295:     }
1.335     albertel 8296: 
1.315     albertel 8297:     return $result;
                   8298: }
                   8299: 
1.1034    www      8300: sub wishlist_window {
                   8301:     return(<<'ENDWISHLIST');
1.1046    raeburn  8302: <script type="text/javascript">
1.1034    www      8303: // <![CDATA[
                   8304: // <!-- BEGIN LON-CAPA Internal
                   8305: function set_wishlistlink(title, path) {
                   8306:     if (!title) {
                   8307:         title = document.title;
                   8308:         title = title.replace(/^LON-CAPA /,'');
                   8309:     }
1.1075.2.65  raeburn  8310:     title = encodeURIComponent(title);
1.1075.2.83  raeburn  8311:     title = title.replace("'","\\\'");
1.1034    www      8312:     if (!path) {
                   8313:         path = location.pathname;
                   8314:     }
1.1075.2.65  raeburn  8315:     path = encodeURIComponent(path);
1.1075.2.83  raeburn  8316:     path = path.replace("'","\\\'");
1.1034    www      8317:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   8318:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   8319: }
                   8320: // END LON-CAPA Internal -->
                   8321: // ]]>
                   8322: </script>
                   8323: ENDWISHLIST
                   8324: }
                   8325: 
1.1030    www      8326: sub modal_window {
                   8327:     return(<<'ENDMODAL');
1.1046    raeburn  8328: <script type="text/javascript">
1.1030    www      8329: // <![CDATA[
                   8330: // <!-- BEGIN LON-CAPA Internal
                   8331: var modalWindow = {
                   8332: 	parent:"body",
                   8333: 	windowId:null,
                   8334: 	content:null,
                   8335: 	width:null,
                   8336: 	height:null,
                   8337: 	close:function()
                   8338: 	{
                   8339: 	        $(".LCmodal-window").remove();
                   8340: 	        $(".LCmodal-overlay").remove();
                   8341: 	},
                   8342: 	open:function()
                   8343: 	{
                   8344: 		var modal = "";
                   8345: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   8346: 		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;\">";
                   8347: 		modal += this.content;
                   8348: 		modal += "</div>";	
                   8349: 
                   8350: 		$(this.parent).append(modal);
                   8351: 
                   8352: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   8353: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   8354: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   8355: 	}
                   8356: };
1.1075.2.42  raeburn  8357: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      8358: 	{
1.1075.2.119  raeburn  8359:                 source = source.replace(/'/g,"&#39;");
1.1030    www      8360: 		modalWindow.windowId = "myModal";
                   8361: 		modalWindow.width = width;
                   8362: 		modalWindow.height = height;
1.1075.2.80  raeburn  8363: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      8364: 		modalWindow.open();
1.1075.2.87  raeburn  8365: 	};
1.1030    www      8366: // END LON-CAPA Internal -->
                   8367: // ]]>
                   8368: </script>
                   8369: ENDMODAL
                   8370: }
                   8371: 
                   8372: sub modal_link {
1.1075.2.42  raeburn  8373:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      8374:     unless ($width) { $width=480; }
                   8375:     unless ($height) { $height=400; }
1.1031    www      8376:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  8377:     unless ($transparency) { $transparency='true'; }
                   8378: 
1.1074    raeburn  8379:     my $target_attr;
                   8380:     if (defined($target)) {
                   8381:         $target_attr = 'target="'.$target.'"';
                   8382:     }
                   8383:     return <<"ENDLINK";
1.1075.2.42  raeburn  8384: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  8385:            $linktext</a>
                   8386: ENDLINK
1.1030    www      8387: }
                   8388: 
1.1032    www      8389: sub modal_adhoc_script {
                   8390:     my ($funcname,$width,$height,$content)=@_;
                   8391:     return (<<ENDADHOC);
1.1046    raeburn  8392: <script type="text/javascript">
1.1032    www      8393: // <![CDATA[
                   8394:         var $funcname = function()
                   8395:         {
                   8396:                 modalWindow.windowId = "myModal";
                   8397:                 modalWindow.width = $width;
                   8398:                 modalWindow.height = $height;
                   8399:                 modalWindow.content = '$content';
                   8400:                 modalWindow.open();
                   8401:         };  
                   8402: // ]]>
                   8403: </script>
                   8404: ENDADHOC
                   8405: }
                   8406: 
1.1041    www      8407: sub modal_adhoc_inner {
                   8408:     my ($funcname,$width,$height,$content)=@_;
                   8409:     my $innerwidth=$width-20;
                   8410:     $content=&js_ready(
1.1042    www      8411:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  8412:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   8413:                  $content.
1.1041    www      8414:                  &end_scrollbox().
1.1075.2.42  raeburn  8415:                  &end_page()
1.1041    www      8416:              );
                   8417:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   8418: }
                   8419: 
                   8420: sub modal_adhoc_window {
                   8421:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   8422:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   8423:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   8424: }
                   8425: 
                   8426: sub modal_adhoc_launch {
                   8427:     my ($funcname,$width,$height,$content)=@_;
                   8428:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   8429: <script type="text/javascript">
                   8430: // <![CDATA[
                   8431: $funcname();
                   8432: // ]]>
                   8433: </script>
                   8434: ENDLAUNCH
                   8435: }
                   8436: 
                   8437: sub modal_adhoc_close {
                   8438:     return (<<ENDCLOSE);
                   8439: <script type="text/javascript">
                   8440: // <![CDATA[
                   8441: modalWindow.close();
                   8442: // ]]>
                   8443: </script>
                   8444: ENDCLOSE
                   8445: }
                   8446: 
1.1038    www      8447: sub togglebox_script {
                   8448:    return(<<ENDTOGGLE);
                   8449: <script type="text/javascript"> 
                   8450: // <![CDATA[
                   8451: function LCtoggleDisplay(id,hidetext,showtext) {
                   8452:    link = document.getElementById(id + "link").childNodes[0];
                   8453:    with (document.getElementById(id).style) {
                   8454:       if (display == "none" ) {
                   8455:           display = "inline";
                   8456:           link.nodeValue = hidetext;
                   8457:         } else {
                   8458:           display = "none";
                   8459:           link.nodeValue = showtext;
                   8460:        }
                   8461:    }
                   8462: }
                   8463: // ]]>
                   8464: </script>
                   8465: ENDTOGGLE
                   8466: }
                   8467: 
1.1039    www      8468: sub start_togglebox {
                   8469:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8470:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8471:     unless ($showtext) { $showtext=&mt('show'); }
                   8472:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8473:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8474:     return &start_data_table().
                   8475:            &start_data_table_header_row().
                   8476:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8477:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8478:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8479:            &end_data_table_header_row().
                   8480:            '<tr id="'.$id.'" style="display:none""><td>';
                   8481: }
                   8482: 
                   8483: sub end_togglebox {
                   8484:     return '</td></tr>'.&end_data_table();
                   8485: }
                   8486: 
1.1041    www      8487: sub LCprogressbar_script {
1.1075.2.130  raeburn  8488:    my ($id,$number_to_do)=@_;
                   8489:    if ($number_to_do) {
                   8490:        return(<<ENDPROGRESS);
1.1041    www      8491: <script type="text/javascript">
                   8492: // <![CDATA[
1.1045    www      8493: \$('#progressbar$id').progressbar({
1.1041    www      8494:   value: 0,
                   8495:   change: function(event, ui) {
                   8496:     var newVal = \$(this).progressbar('option', 'value');
                   8497:     \$('.pblabel', this).text(LCprogressTxt);
                   8498:   }
                   8499: });
                   8500: // ]]>
                   8501: </script>
                   8502: ENDPROGRESS
1.1075.2.130  raeburn  8503:    } else {
                   8504:        return(<<ENDPROGRESS);
                   8505: <script type="text/javascript">
                   8506: // <![CDATA[
                   8507: \$('#progressbar$id').progressbar({
                   8508:   value: false,
                   8509:   create: function(event, ui) {
                   8510:     \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
                   8511:     \$('.ui-progressbar-overlay', this).css({'margin':'0'});
                   8512:   }
                   8513: });
                   8514: // ]]>
                   8515: </script>
                   8516: ENDPROGRESS
                   8517:    }
1.1041    www      8518: }
                   8519: 
                   8520: sub LCprogressbarUpdate_script {
                   8521:    return(<<ENDPROGRESSUPDATE);
                   8522: <style type="text/css">
                   8523: .ui-progressbar { position:relative; }
1.1075.2.130  raeburn  8524: .progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
1.1041    www      8525: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8526: </style>
                   8527: <script type="text/javascript">
                   8528: // <![CDATA[
1.1045    www      8529: var LCprogressTxt='---';
                   8530: 
1.1075.2.130  raeburn  8531: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041    www      8532:    LCprogressTxt=progresstext;
1.1075.2.130  raeburn  8533:    if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
                   8534:        \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
                   8535:    } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
                   8536:        \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
                   8537:    } else {
                   8538:        \$('#progressbar'+id).progressbar('value',percent);
                   8539:    }
1.1041    www      8540: }
                   8541: // ]]>
                   8542: </script>
                   8543: ENDPROGRESSUPDATE
                   8544: }
                   8545: 
1.1042    www      8546: my $LClastpercent;
1.1045    www      8547: my $LCidcnt;
                   8548: my $LCcurrentid;
1.1042    www      8549: 
1.1041    www      8550: sub LCprogressbar {
1.1075.2.130  raeburn  8551:     my ($r,$number_to_do,$preamble)=@_;
1.1042    www      8552:     $LClastpercent=0;
1.1045    www      8553:     $LCidcnt++;
                   8554:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1075.2.130  raeburn  8555:     my ($starting,$content);
                   8556:     if ($number_to_do) {
                   8557:         $starting=&mt('Starting');
                   8558:         $content=(<<ENDPROGBAR);
                   8559: $preamble
1.1045    www      8560:   <div id="progressbar$LCcurrentid">
1.1041    www      8561:     <span class="pblabel">$starting</span>
                   8562:   </div>
                   8563: ENDPROGBAR
1.1075.2.130  raeburn  8564:     } else {
                   8565:         $starting=&mt('Loading...');
                   8566:         $LClastpercent='false';
                   8567:         $content=(<<ENDPROGBAR);
                   8568: $preamble
                   8569:   <div id="progressbar$LCcurrentid">
                   8570:       <div class="progress-label">$starting</div>
                   8571:   </div>
                   8572: ENDPROGBAR
                   8573:     }
                   8574:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041    www      8575: }
                   8576: 
                   8577: sub LCprogressbarUpdate {
1.1075.2.130  raeburn  8578:     my ($r,$val,$text,$number_to_do)=@_;
                   8579:     if ($number_to_do) {
                   8580:         unless ($val) { 
                   8581:             if ($LClastpercent) {
                   8582:                 $val=$LClastpercent;
                   8583:             } else {
                   8584:                 $val=0;
                   8585:             }
                   8586:         }
                   8587:         if ($val<0) { $val=0; }
                   8588:         if ($val>100) { $val=0; }
                   8589:         $LClastpercent=$val;
                   8590:         unless ($text) { $text=$val.'%'; }
                   8591:     } else {
                   8592:         $val = 'false';
1.1042    www      8593:     }
1.1041    www      8594:     $text=&js_ready($text);
1.1044    www      8595:     &r_print($r,<<ENDUPDATE);
1.1041    www      8596: <script type="text/javascript">
                   8597: // <![CDATA[
1.1075.2.130  raeburn  8598: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041    www      8599: // ]]>
                   8600: </script>
                   8601: ENDUPDATE
1.1035    www      8602: }
                   8603: 
1.1042    www      8604: sub LCprogressbarClose {
                   8605:     my ($r)=@_;
                   8606:     $LClastpercent=0;
1.1044    www      8607:     &r_print($r,<<ENDCLOSE);
1.1042    www      8608: <script type="text/javascript">
                   8609: // <![CDATA[
1.1045    www      8610: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8611: // ]]>
                   8612: </script>
                   8613: ENDCLOSE
1.1044    www      8614: }
                   8615: 
                   8616: sub r_print {
                   8617:     my ($r,$to_print)=@_;
                   8618:     if ($r) {
                   8619:       $r->print($to_print);
                   8620:       $r->rflush();
                   8621:     } else {
                   8622:       print($to_print);
                   8623:     }
1.1042    www      8624: }
                   8625: 
1.320     albertel 8626: sub html_encode {
                   8627:     my ($result) = @_;
                   8628: 
1.322     albertel 8629:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8630:     
                   8631:     return $result;
                   8632: }
1.1044    www      8633: 
1.317     albertel 8634: sub js_ready {
                   8635:     my ($result) = @_;
                   8636: 
1.323     albertel 8637:     $result =~ s/[\n\r]/ /xmsg;
                   8638:     $result =~ s/\\/\\\\/xmsg;
                   8639:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8640:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8641:     
                   8642:     return $result;
                   8643: }
                   8644: 
1.315     albertel 8645: sub validate_page {
                   8646:     if (  exists($env{'internal.start_page'})
1.316     albertel 8647: 	  &&     $env{'internal.start_page'} > 1) {
                   8648: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8649: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8650: 				 $ENV{'request.filename'});
1.315     albertel 8651:     }
                   8652:     if (  exists($env{'internal.end_page'})
1.316     albertel 8653: 	  &&     $env{'internal.end_page'} > 1) {
                   8654: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8655: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8656: 				 $env{'request.filename'});
1.315     albertel 8657:     }
                   8658:     if (     exists($env{'internal.start_page'})
                   8659: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8660: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8661: 				 $env{'request.filename'});
1.315     albertel 8662:     }
                   8663:     if (   ! exists($env{'internal.start_page'})
                   8664: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8665: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8666: 				 $env{'request.filename'});
1.315     albertel 8667:     }
1.306     albertel 8668: }
1.315     albertel 8669: 
1.996     www      8670: 
                   8671: sub start_scrollbox {
1.1075.2.56  raeburn  8672:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8673:     unless ($outerwidth) { $outerwidth='520px'; }
                   8674:     unless ($width) { $width='500px'; }
                   8675:     unless ($height) { $height='200px'; }
1.1075    raeburn  8676:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8677:     if ($id ne '') {
1.1075.2.42  raeburn  8678:         $table_id = ' id="table_'.$id.'"';
                   8679:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8680:     }
1.1075    raeburn  8681:     if ($bgcolor ne '') {
                   8682:         $tdcol = "background-color: $bgcolor;";
                   8683:     }
1.1075.2.42  raeburn  8684:     my $nicescroll_js;
                   8685:     if ($env{'browser.mobile'}) {
                   8686:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8687:     }
1.1075    raeburn  8688:     return <<"END";
1.1075.2.42  raeburn  8689: $nicescroll_js
                   8690: 
                   8691: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8692: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8693: END
1.996     www      8694: }
                   8695: 
                   8696: sub end_scrollbox {
1.1036    www      8697:     return '</div></td></tr></table>';
1.996     www      8698: }
                   8699: 
1.1075.2.42  raeburn  8700: sub nicescroll_javascript {
                   8701:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8702:     my %options;
                   8703:     if (ref($cursor) eq 'HASH') {
                   8704:         %options = %{$cursor};
                   8705:     }
                   8706:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8707:         $options{'railalign'} = 'left';
                   8708:     }
                   8709:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8710:         my $function  = &get_users_function();
                   8711:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8712:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8713:             $options{'cursorcolor'} = '#00F';
                   8714:         }
                   8715:     }
                   8716:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8717:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8718:             $options{'cursoropacity'}='1.0';
                   8719:         }
                   8720:     } else {
                   8721:         $options{'cursoropacity'}='1.0';
                   8722:     }
                   8723:     if ($options{'cursorfixedheight'} eq 'none') {
                   8724:         delete($options{'cursorfixedheight'});
                   8725:     } else {
                   8726:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8727:     }
                   8728:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8729:         delete($options{'railoffset'});
                   8730:     }
                   8731:     my @niceoptions;
                   8732:     while (my($key,$value) = each(%options)) {
                   8733:         if ($value =~ /^\{.+\}$/) {
                   8734:             push(@niceoptions,$key.':'.$value);
                   8735:         } else {
                   8736:             push(@niceoptions,$key.':"'.$value.'"');
                   8737:         }
                   8738:     }
                   8739:     my $nicescroll_js = '
                   8740: $(document).ready(
                   8741:       function() {
                   8742:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8743:       }
                   8744: );
                   8745: ';
                   8746:     if ($framecheck) {
                   8747:         $nicescroll_js .= '
                   8748: function expand_div(caller) {
                   8749:     if (top === self) {
                   8750:         document.getElementById("'.$id.'").style.width = "auto";
                   8751:         document.getElementById("'.$id.'").style.height = "auto";
                   8752:     } else {
                   8753:         try {
                   8754:             if (parent.frames) {
                   8755:                 if (parent.frames.length > 1) {
                   8756:                     var framesrc = parent.frames[1].location.href;
                   8757:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8758:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8759:                         document.getElementById("'.$id.'").style.width = "auto";
                   8760:                         document.getElementById("'.$id.'").style.height = "auto";
                   8761:                     }
                   8762:                 }
                   8763:             }
                   8764:         } catch (e) {
                   8765:             return;
                   8766:         }
                   8767:     }
                   8768:     return;
                   8769: }
                   8770: ';
                   8771:     }
                   8772:     if ($needjsready) {
                   8773:         $nicescroll_js = '
                   8774: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8775:     } else {
                   8776:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8777:     }
                   8778:     return $nicescroll_js;
                   8779: }
                   8780: 
1.318     albertel 8781: sub simple_error_page {
1.1075.2.49  raeburn  8782:     my ($r,$title,$msg,$args) = @_;
                   8783:     if (ref($args) eq 'HASH') {
                   8784:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8785:     } else {
                   8786:         $msg = &mt($msg);
                   8787:     }
                   8788: 
1.318     albertel 8789:     my $page =
                   8790: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  8791: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8792: 	&Apache::loncommon::end_page();
                   8793:     if (ref($r)) {
                   8794: 	$r->print($page);
1.327     albertel 8795: 	return;
1.318     albertel 8796:     }
                   8797:     return $page;
                   8798: }
1.347     albertel 8799: 
                   8800: {
1.610     albertel 8801:     my @row_count;
1.961     onken    8802: 
                   8803:     sub start_data_table_count {
                   8804:         unshift(@row_count, 0);
                   8805:         return;
                   8806:     }
                   8807: 
                   8808:     sub end_data_table_count {
                   8809:         shift(@row_count);
                   8810:         return;
                   8811:     }
                   8812: 
1.347     albertel 8813:     sub start_data_table {
1.1018    raeburn  8814: 	my ($add_class,$id) = @_;
1.422     albertel 8815: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8816:         my $table_id;
                   8817:         if (defined($id)) {
                   8818:             $table_id = ' id="'.$id.'"';
                   8819:         }
1.961     onken    8820: 	&start_data_table_count();
1.1018    raeburn  8821: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8822:     }
                   8823: 
                   8824:     sub end_data_table {
1.961     onken    8825: 	&end_data_table_count();
1.389     albertel 8826: 	return '</table>'."\n";;
1.347     albertel 8827:     }
                   8828: 
                   8829:     sub start_data_table_row {
1.974     wenzelju 8830: 	my ($add_class, $id) = @_;
1.610     albertel 8831: 	$row_count[0]++;
                   8832: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8833: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8834:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8835:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8836:     }
1.471     banghart 8837:     
                   8838:     sub continue_data_table_row {
1.974     wenzelju 8839: 	my ($add_class, $id) = @_;
1.610     albertel 8840: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8841: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8842:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8843:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8844:     }
1.347     albertel 8845: 
                   8846:     sub end_data_table_row {
1.389     albertel 8847: 	return '</tr>'."\n";;
1.347     albertel 8848:     }
1.367     www      8849: 
1.421     albertel 8850:     sub start_data_table_empty_row {
1.707     bisitz   8851: #	$row_count[0]++;
1.421     albertel 8852: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8853:     }
                   8854: 
                   8855:     sub end_data_table_empty_row {
                   8856: 	return '</tr>'."\n";;
                   8857:     }
                   8858: 
1.367     www      8859:     sub start_data_table_header_row {
1.389     albertel 8860: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8861:     }
                   8862: 
                   8863:     sub end_data_table_header_row {
1.389     albertel 8864: 	return '</tr>'."\n";;
1.367     www      8865:     }
1.890     droeschl 8866: 
                   8867:     sub data_table_caption {
                   8868:         my $caption = shift;
                   8869:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8870:     }
1.347     albertel 8871: }
                   8872: 
1.548     albertel 8873: =pod
                   8874: 
                   8875: =item * &inhibit_menu_check($arg)
                   8876: 
                   8877: Checks for a inhibitmenu state and generates output to preserve it
                   8878: 
                   8879: Inputs:         $arg - can be any of
                   8880:                      - undef - in which case the return value is a string 
                   8881:                                to add  into arguments list of a uri
                   8882:                      - 'input' - in which case the return value is a HTML
                   8883:                                  <form> <input> field of type hidden to
                   8884:                                  preserve the value
                   8885:                      - a url - in which case the return value is the url with
                   8886:                                the neccesary cgi args added to preserve the
                   8887:                                inhibitmenu state
                   8888:                      - a ref to a url - no return value, but the string is
                   8889:                                         updated to include the neccessary cgi
                   8890:                                         args to preserve the inhibitmenu state
                   8891: 
                   8892: =cut
                   8893: 
                   8894: sub inhibit_menu_check {
                   8895:     my ($arg) = @_;
                   8896:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8897:     if ($arg eq 'input') {
                   8898: 	if ($env{'form.inhibitmenu'}) {
                   8899: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8900: 	} else {
                   8901: 	    return
                   8902: 	}
                   8903:     }
                   8904:     if ($env{'form.inhibitmenu'}) {
                   8905: 	if (ref($arg)) {
                   8906: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8907: 	} elsif ($arg eq '') {
                   8908: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8909: 	} else {
                   8910: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8911: 	}
                   8912:     }
                   8913:     if (!ref($arg)) {
                   8914: 	return $arg;
                   8915:     }
                   8916: }
                   8917: 
1.251     albertel 8918: ###############################################
1.182     matthew  8919: 
                   8920: =pod
                   8921: 
1.549     albertel 8922: =back
                   8923: 
                   8924: =head1 User Information Routines
                   8925: 
                   8926: =over 4
                   8927: 
1.405     albertel 8928: =item * &get_users_function()
1.182     matthew  8929: 
                   8930: Used by &bodytag to determine the current users primary role.
                   8931: Returns either 'student','coordinator','admin', or 'author'.
                   8932: 
                   8933: =cut
                   8934: 
                   8935: ###############################################
                   8936: sub get_users_function {
1.815     tempelho 8937:     my $function = 'norole';
1.818     tempelho 8938:     if ($env{'request.role'}=~/^(st)/) {
                   8939:         $function='student';
                   8940:     }
1.907     raeburn  8941:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8942:         $function='coordinator';
                   8943:     }
1.258     albertel 8944:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8945:         $function='admin';
                   8946:     }
1.826     bisitz   8947:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8948:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8949:         $function='author';
                   8950:     }
                   8951:     return $function;
1.54      www      8952: }
1.99      www      8953: 
                   8954: ###############################################
                   8955: 
1.233     raeburn  8956: =pod
                   8957: 
1.821     raeburn  8958: =item * &show_course()
                   8959: 
                   8960: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8961: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8962: 
                   8963: Inputs:
                   8964: None
                   8965: 
                   8966: Outputs:
                   8967: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8968: 
                   8969: =cut
                   8970: 
                   8971: ###############################################
                   8972: sub show_course {
                   8973:     my $course = !$env{'user.adv'};
                   8974:     if (!$env{'user.adv'}) {
                   8975:         foreach my $env (keys(%env)) {
                   8976:             next if ($env !~ m/^user\.priv\./);
                   8977:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8978:                 $course = 0;
                   8979:                 last;
                   8980:             }
                   8981:         }
                   8982:     }
                   8983:     return $course;
                   8984: }
                   8985: 
                   8986: ###############################################
                   8987: 
                   8988: =pod
                   8989: 
1.542     raeburn  8990: =item * &check_user_status()
1.274     raeburn  8991: 
                   8992: Determines current status of supplied role for a
                   8993: specific user. Roles can be active, previous or future.
                   8994: 
                   8995: Inputs: 
                   8996: user's domain, user's username, course's domain,
1.375     raeburn  8997: course's number, optional section ID.
1.274     raeburn  8998: 
                   8999: Outputs:
                   9000: role status: active, previous or future. 
                   9001: 
                   9002: =cut
                   9003: 
                   9004: sub check_user_status {
1.412     raeburn  9005:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  9006:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85  raeburn  9007:     my @uroles = keys(%userinfo);
1.274     raeburn  9008:     my $srchstr;
                   9009:     my $active_chk = 'none';
1.412     raeburn  9010:     my $now = time;
1.274     raeburn  9011:     if (@uroles > 0) {
1.908     raeburn  9012:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  9013:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   9014:         } else {
1.412     raeburn  9015:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   9016:         }
                   9017:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  9018:             my $role_end = 0;
                   9019:             my $role_start = 0;
                   9020:             $active_chk = 'active';
1.412     raeburn  9021:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   9022:                 $role_end = $1;
                   9023:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   9024:                     $role_start = $1;
1.274     raeburn  9025:                 }
                   9026:             }
                   9027:             if ($role_start > 0) {
1.412     raeburn  9028:                 if ($now < $role_start) {
1.274     raeburn  9029:                     $active_chk = 'future';
                   9030:                 }
                   9031:             }
                   9032:             if ($role_end > 0) {
1.412     raeburn  9033:                 if ($now > $role_end) {
1.274     raeburn  9034:                     $active_chk = 'previous';
                   9035:                 }
                   9036:             }
                   9037:         }
                   9038:     }
                   9039:     return $active_chk;
                   9040: }
                   9041: 
                   9042: ###############################################
                   9043: 
                   9044: =pod
                   9045: 
1.405     albertel 9046: =item * &get_sections()
1.233     raeburn  9047: 
                   9048: Determines all the sections for a course including
                   9049: sections with students and sections containing other roles.
1.419     raeburn  9050: Incoming parameters: 
                   9051: 
                   9052: 1. domain
                   9053: 2. course number 
                   9054: 3. reference to array containing roles for which sections should 
                   9055: be gathered (optional).
                   9056: 4. reference to array containing status types for which sections 
                   9057: should be gathered (optional).
                   9058: 
                   9059: If the third argument is undefined, sections are gathered for any role. 
                   9060: If the fourth argument is undefined, sections are gathered for any status.
                   9061: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  9062:  
1.374     raeburn  9063: Returns section hash (keys are section IDs, values are
                   9064: number of users in each section), subject to the
1.419     raeburn  9065: optional roles filter, optional status filter 
1.233     raeburn  9066: 
                   9067: =cut
                   9068: 
                   9069: ###############################################
                   9070: sub get_sections {
1.419     raeburn  9071:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 9072:     if (!defined($cdom) || !defined($cnum)) {
                   9073:         my $cid =  $env{'request.course.id'};
                   9074: 
                   9075: 	return if (!defined($cid));
                   9076: 
                   9077:         $cdom = $env{'course.'.$cid.'.domain'};
                   9078:         $cnum = $env{'course.'.$cid.'.num'};
                   9079:     }
                   9080: 
                   9081:     my %sectioncount;
1.419     raeburn  9082:     my $now = time;
1.240     albertel 9083: 
1.1075.2.33  raeburn  9084:     my $check_students = 1;
                   9085:     my $only_students = 0;
                   9086:     if (ref($possible_roles) eq 'ARRAY') {
                   9087:         if (grep(/^st$/,@{$possible_roles})) {
                   9088:             if (@{$possible_roles} == 1) {
                   9089:                 $only_students = 1;
                   9090:             }
                   9091:         } else {
                   9092:             $check_students = 0;
                   9093:         }
                   9094:     }
                   9095: 
                   9096:     if ($check_students) {
1.276     albertel 9097: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 9098: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   9099: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  9100:         my $start_index = &Apache::loncoursedata::CL_START();
                   9101:         my $end_index = &Apache::loncoursedata::CL_END();
                   9102:         my $status;
1.366     albertel 9103: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  9104: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   9105: 				                     $data->[$status_index],
                   9106:                                                      $data->[$start_index],
                   9107:                                                      $data->[$end_index]);
                   9108:             if ($stu_status eq 'Active') {
                   9109:                 $status = 'active';
                   9110:             } elsif ($end < $now) {
                   9111:                 $status = 'previous';
                   9112:             } elsif ($start > $now) {
                   9113:                 $status = 'future';
                   9114:             } 
                   9115: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   9116:                 if ((!defined($possible_status)) || (($status ne '') && 
                   9117:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   9118: 		    $sectioncount{$section}++;
                   9119:                 }
1.240     albertel 9120: 	    }
                   9121: 	}
                   9122:     }
1.1075.2.33  raeburn  9123:     if ($only_students) {
                   9124:         return %sectioncount;
                   9125:     }
1.240     albertel 9126:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9127:     foreach my $user (sort(keys(%courseroles))) {
                   9128: 	if ($user !~ /^(\w{2})/) { next; }
                   9129: 	my ($role) = ($user =~ /^(\w{2})/);
                   9130: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  9131: 	my ($section,$status);
1.240     albertel 9132: 	if ($role eq 'cr' &&
                   9133: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   9134: 	    $section=$1;
                   9135: 	}
                   9136: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   9137: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  9138:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   9139:         if ($end == -1 && $start == -1) {
                   9140:             next; #deleted role
                   9141:         }
                   9142:         if (!defined($possible_status)) { 
                   9143:             $sectioncount{$section}++;
                   9144:         } else {
                   9145:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   9146:                 $status = 'active';
                   9147:             } elsif ($end < $now) {
                   9148:                 $status = 'future';
                   9149:             } elsif ($start > $now) {
                   9150:                 $status = 'previous';
                   9151:             }
                   9152:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   9153:                 $sectioncount{$section}++;
                   9154:             }
                   9155:         }
1.233     raeburn  9156:     }
1.366     albertel 9157:     return %sectioncount;
1.233     raeburn  9158: }
                   9159: 
1.274     raeburn  9160: ###############################################
1.294     raeburn  9161: 
                   9162: =pod
1.405     albertel 9163: 
                   9164: =item * &get_course_users()
                   9165: 
1.275     raeburn  9166: Retrieves usernames:domains for users in the specified course
                   9167: with specific role(s), and access status. 
                   9168: 
                   9169: Incoming parameters:
1.277     albertel 9170: 1. course domain
                   9171: 2. course number
                   9172: 3. access status: users must have - either active, 
1.275     raeburn  9173: previous, future, or all.
1.277     albertel 9174: 4. reference to array of permissible roles
1.288     raeburn  9175: 5. reference to array of section restrictions (optional)
                   9176: 6. reference to results object (hash of hashes).
                   9177: 7. reference to optional userdata hash
1.609     raeburn  9178: 8. reference to optional statushash
1.630     raeburn  9179: 9. flag if privileged users (except those set to unhide in
                   9180:    course settings) should be excluded    
1.609     raeburn  9181: Keys of top level results hash are roles.
1.275     raeburn  9182: Keys of inner hashes are username:domain, with 
                   9183: values set to access type.
1.288     raeburn  9184: Optional userdata hash returns an array with arguments in the 
                   9185: same order as loncoursedata::get_classlist() for student data.
                   9186: 
1.609     raeburn  9187: Optional statushash returns
                   9188: 
1.288     raeburn  9189: Entries for end, start, section and status are blank because
                   9190: of the possibility of multiple values for non-student roles.
                   9191: 
1.275     raeburn  9192: =cut
1.405     albertel 9193: 
1.275     raeburn  9194: ###############################################
1.405     albertel 9195: 
1.275     raeburn  9196: sub get_course_users {
1.630     raeburn  9197:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  9198:     my %idx = ();
1.419     raeburn  9199:     my %seclists;
1.288     raeburn  9200: 
                   9201:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   9202:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   9203:     $idx{end} = &Apache::loncoursedata::CL_END();
                   9204:     $idx{start} = &Apache::loncoursedata::CL_START();
                   9205:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   9206:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   9207:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   9208:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   9209: 
1.290     albertel 9210:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 9211:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  9212:         my $now = time;
1.277     albertel 9213:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  9214:             my $match = 0;
1.412     raeburn  9215:             my $secmatch = 0;
1.419     raeburn  9216:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  9217:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  9218:             if ($section eq '') {
                   9219:                 $section = 'none';
                   9220:             }
1.291     albertel 9221:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9222:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9223:                     $secmatch = 1;
                   9224:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 9225:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9226:                         $secmatch = 1;
                   9227:                     }
                   9228:                 } else {  
1.419     raeburn  9229: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  9230: 		        $secmatch = 1;
                   9231:                     }
1.290     albertel 9232: 		}
1.412     raeburn  9233:                 if (!$secmatch) {
                   9234:                     next;
                   9235:                 }
1.419     raeburn  9236:             }
1.275     raeburn  9237:             if (defined($$types{'active'})) {
1.288     raeburn  9238:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  9239:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  9240:                     $match = 1;
1.275     raeburn  9241:                 }
                   9242:             }
                   9243:             if (defined($$types{'previous'})) {
1.609     raeburn  9244:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  9245:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  9246:                     $match = 1;
1.275     raeburn  9247:                 }
                   9248:             }
                   9249:             if (defined($$types{'future'})) {
1.609     raeburn  9250:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  9251:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  9252:                     $match = 1;
1.275     raeburn  9253:                 }
                   9254:             }
1.609     raeburn  9255:             if ($match) {
                   9256:                 push(@{$seclists{$student}},$section);
                   9257:                 if (ref($userdata) eq 'HASH') {
                   9258:                     $$userdata{$student} = $$classlist{$student};
                   9259:                 }
                   9260:                 if (ref($statushash) eq 'HASH') {
                   9261:                     $statushash->{$student}{'st'}{$section} = $status;
                   9262:                 }
1.288     raeburn  9263:             }
1.275     raeburn  9264:         }
                   9265:     }
1.412     raeburn  9266:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  9267:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9268:         my $now = time;
1.609     raeburn  9269:         my %displaystatus = ( previous => 'Expired',
                   9270:                               active   => 'Active',
                   9271:                               future   => 'Future',
                   9272:                             );
1.1075.2.36  raeburn  9273:         my (%nothide,@possdoms);
1.630     raeburn  9274:         if ($hidepriv) {
                   9275:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   9276:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   9277:                 if ($user !~ /:/) {
                   9278:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   9279:                 } else {
                   9280:                     $nothide{$user} = 1;
                   9281:                 }
                   9282:             }
1.1075.2.36  raeburn  9283:             my @possdoms = ($cdom);
                   9284:             if ($coursehash{'checkforpriv'}) {
                   9285:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   9286:             }
1.630     raeburn  9287:         }
1.439     raeburn  9288:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  9289:             my $match = 0;
1.412     raeburn  9290:             my $secmatch = 0;
1.439     raeburn  9291:             my $status;
1.412     raeburn  9292:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  9293:             $user =~ s/:$//;
1.439     raeburn  9294:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   9295:             if ($end == -1 || $start == -1) {
                   9296:                 next;
                   9297:             }
                   9298:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   9299:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  9300:                 my ($uname,$udom) = split(/:/,$user);
                   9301:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9302:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9303:                         $secmatch = 1;
                   9304:                     } elsif ($usec eq '') {
1.420     albertel 9305:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9306:                             $secmatch = 1;
                   9307:                         }
                   9308:                     } else {
                   9309:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   9310:                             $secmatch = 1;
                   9311:                         }
                   9312:                     }
                   9313:                     if (!$secmatch) {
                   9314:                         next;
                   9315:                     }
1.288     raeburn  9316:                 }
1.419     raeburn  9317:                 if ($usec eq '') {
                   9318:                     $usec = 'none';
                   9319:                 }
1.275     raeburn  9320:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  9321:                     if ($hidepriv) {
1.1075.2.36  raeburn  9322:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  9323:                             (!$nothide{$uname.':'.$udom})) {
                   9324:                             next;
                   9325:                         }
                   9326:                     }
1.503     raeburn  9327:                     if ($end > 0 && $end < $now) {
1.439     raeburn  9328:                         $status = 'previous';
                   9329:                     } elsif ($start > $now) {
                   9330:                         $status = 'future';
                   9331:                     } else {
                   9332:                         $status = 'active';
                   9333:                     }
1.277     albertel 9334:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  9335:                         if ($status eq $type) {
1.420     albertel 9336:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  9337:                                 push(@{$$users{$role}{$user}},$type);
                   9338:                             }
1.288     raeburn  9339:                             $match = 1;
                   9340:                         }
                   9341:                     }
1.419     raeburn  9342:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   9343:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   9344: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   9345:                         }
1.420     albertel 9346:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  9347:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   9348:                         }
1.609     raeburn  9349:                         if (ref($statushash) eq 'HASH') {
                   9350:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   9351:                         }
1.275     raeburn  9352:                     }
                   9353:                 }
                   9354:             }
                   9355:         }
1.290     albertel 9356:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  9357:             if ((defined($cdom)) && (defined($cnum))) {
                   9358:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   9359:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   9360:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  9361:                     next if ($owner eq '');
                   9362:                     my ($ownername,$ownerdom);
                   9363:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   9364:                         $ownername = $1;
                   9365:                         $ownerdom = $2;
                   9366:                     } else {
                   9367:                         $ownername = $owner;
                   9368:                         $ownerdom = $cdom;
                   9369:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  9370:                     }
                   9371:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 9372:                     if (defined($userdata) && 
1.609     raeburn  9373: 			!exists($$userdata{$owner})) {
                   9374: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   9375:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   9376:                             push(@{$seclists{$owner}},'none');
                   9377:                         }
                   9378:                         if (ref($statushash) eq 'HASH') {
                   9379:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  9380:                         }
1.290     albertel 9381: 		    }
1.279     raeburn  9382:                 }
                   9383:             }
                   9384:         }
1.419     raeburn  9385:         foreach my $user (keys(%seclists)) {
                   9386:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   9387:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   9388:         }
1.275     raeburn  9389:     }
                   9390:     return;
                   9391: }
                   9392: 
1.288     raeburn  9393: sub get_user_info {
                   9394:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 9395:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   9396: 	&plainname($uname,$udom,'lastname');
1.291     albertel 9397:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  9398:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  9399:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   9400:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  9401:     return;
                   9402: }
1.275     raeburn  9403: 
1.472     raeburn  9404: ###############################################
                   9405: 
                   9406: =pod
                   9407: 
                   9408: =item * &get_user_quota()
                   9409: 
1.1075.2.41  raeburn  9410: Retrieves quota assigned for storage of user files.
                   9411: Default is to report quota for portfolio files.
1.472     raeburn  9412: 
                   9413: Incoming parameters:
                   9414: 1. user's username
                   9415: 2. user's domain
1.1075.2.41  raeburn  9416: 3. quota name - portfolio, author, or course
                   9417:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  9418: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  9419:    course
1.472     raeburn  9420: 
                   9421: Returns:
1.1075.2.58  raeburn  9422: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  9423: 2. (Optional) Type of setting: custom or default
                   9424:    (individually assigned or default for user's 
                   9425:    institutional status).
                   9426: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   9427:    or student - types as defined in localenroll::inst_usertypes 
                   9428:    for user's domain, which determines default quota for user.
                   9429: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  9430: 
                   9431: If a value has been stored in the user's environment, 
1.536     raeburn  9432: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  9433: defined for the user's institutional status(es) in the domain.
1.472     raeburn  9434: 
                   9435: =cut
                   9436: 
                   9437: ###############################################
                   9438: 
                   9439: 
                   9440: sub get_user_quota {
1.1075.2.42  raeburn  9441:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  9442:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  9443:     if (!defined($udom)) {
                   9444:         $udom = $env{'user.domain'};
                   9445:     }
                   9446:     if (!defined($uname)) {
                   9447:         $uname = $env{'user.name'};
                   9448:     }
                   9449:     if (($udom eq '' || $uname eq '') ||
                   9450:         ($udom eq 'public') && ($uname eq 'public')) {
                   9451:         $quota = 0;
1.536     raeburn  9452:         $quotatype = 'default';
                   9453:         $defquota = 0; 
1.472     raeburn  9454:     } else {
1.536     raeburn  9455:         my $inststatus;
1.1075.2.41  raeburn  9456:         if ($quotaname eq 'course') {
                   9457:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   9458:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   9459:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   9460:             } else {
                   9461:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   9462:                 $quota = $cenv{'internal.uploadquota'};
                   9463:             }
1.536     raeburn  9464:         } else {
1.1075.2.41  raeburn  9465:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   9466:                 if ($quotaname eq 'author') {
                   9467:                     $quota = $env{'environment.authorquota'};
                   9468:                 } else {
                   9469:                     $quota = $env{'environment.portfolioquota'};
                   9470:                 }
                   9471:                 $inststatus = $env{'environment.inststatus'};
                   9472:             } else {
                   9473:                 my %userenv = 
                   9474:                     &Apache::lonnet::get('environment',['portfolioquota',
                   9475:                                          'authorquota','inststatus'],$udom,$uname);
                   9476:                 my ($tmp) = keys(%userenv);
                   9477:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9478:                     if ($quotaname eq 'author') {
                   9479:                         $quota = $userenv{'authorquota'};
                   9480:                     } else {
                   9481:                         $quota = $userenv{'portfolioquota'};
                   9482:                     }
                   9483:                     $inststatus = $userenv{'inststatus'};
                   9484:                 } else {
                   9485:                     undef(%userenv);
                   9486:                 }
                   9487:             }
                   9488:         }
                   9489:         if ($quota eq '' || wantarray) {
                   9490:             if ($quotaname eq 'course') {
                   9491:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  9492:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   9493:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  9494:                     $defquota = $domdefs{$crstype.'quota'};
                   9495:                 }
                   9496:                 if ($defquota eq '') {
                   9497:                     $defquota = 500;
                   9498:                 }
1.1075.2.41  raeburn  9499:             } else {
                   9500:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   9501:             }
                   9502:             if ($quota eq '') {
                   9503:                 $quota = $defquota;
                   9504:                 $quotatype = 'default';
                   9505:             } else {
                   9506:                 $quotatype = 'custom';
                   9507:             }
1.472     raeburn  9508:         }
                   9509:     }
1.536     raeburn  9510:     if (wantarray) {
                   9511:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9512:     } else {
                   9513:         return $quota;
                   9514:     }
1.472     raeburn  9515: }
                   9516: 
                   9517: ###############################################
                   9518: 
                   9519: =pod
                   9520: 
                   9521: =item * &default_quota()
                   9522: 
1.536     raeburn  9523: Retrieves default quota assigned for storage of user portfolio files,
                   9524: given an (optional) user's institutional status.
1.472     raeburn  9525: 
                   9526: Incoming parameters:
1.1075.2.42  raeburn  9527: 
1.472     raeburn  9528: 1. domain
1.536     raeburn  9529: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9530:    status types (e.g., faculty, staff, student etc.)
                   9531:    which apply to the user for whom the default is being retrieved.
                   9532:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  9533:    default quota will be returned.
                   9534: 3.  quota name - portfolio, author, or course
                   9535:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9536: 
                   9537: Returns:
1.1075.2.42  raeburn  9538: 
1.1075.2.58  raeburn  9539: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9540: 2. (Optional) institutional type which determined the value of the
                   9541:    default quota.
1.472     raeburn  9542: 
                   9543: If a value has been stored in the domain's configuration db,
                   9544: it will return that, otherwise it returns 20 (for backwards 
                   9545: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  9546: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9547: 
1.536     raeburn  9548: If the user's status includes multiple types (e.g., staff and student),
                   9549: the largest default quota which applies to the user determines the
                   9550: default quota returned.
                   9551: 
1.472     raeburn  9552: =cut
                   9553: 
                   9554: ###############################################
                   9555: 
                   9556: 
                   9557: sub default_quota {
1.1075.2.41  raeburn  9558:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9559:     my ($defquota,$settingstatus);
                   9560:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9561:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  9562:     my $key = 'defaultquota';
                   9563:     if ($quotaname eq 'author') {
                   9564:         $key = 'authorquota';
                   9565:     }
1.622     raeburn  9566:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9567:         if ($inststatus ne '') {
1.765     raeburn  9568:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9569:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  9570:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9571:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9572:                         if ($defquota eq '') {
1.1075.2.41  raeburn  9573:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9574:                             $settingstatus = $item;
1.1075.2.41  raeburn  9575:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9576:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9577:                             $settingstatus = $item;
                   9578:                         }
                   9579:                     }
1.1075.2.41  raeburn  9580:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9581:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9582:                         if ($defquota eq '') {
                   9583:                             $defquota = $quotahash{'quotas'}{$item};
                   9584:                             $settingstatus = $item;
                   9585:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9586:                             $defquota = $quotahash{'quotas'}{$item};
                   9587:                             $settingstatus = $item;
                   9588:                         }
1.536     raeburn  9589:                     }
                   9590:                 }
                   9591:             }
                   9592:         }
                   9593:         if ($defquota eq '') {
1.1075.2.41  raeburn  9594:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9595:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9596:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9597:                 $defquota = $quotahash{'quotas'}{'default'};
                   9598:             }
1.536     raeburn  9599:             $settingstatus = 'default';
1.1075.2.42  raeburn  9600:             if ($defquota eq '') {
                   9601:                 if ($quotaname eq 'author') {
                   9602:                     $defquota = 500;
                   9603:                 }
                   9604:             }
1.536     raeburn  9605:         }
                   9606:     } else {
                   9607:         $settingstatus = 'default';
1.1075.2.41  raeburn  9608:         if ($quotaname eq 'author') {
                   9609:             $defquota = 500;
                   9610:         } else {
                   9611:             $defquota = 20;
                   9612:         }
1.536     raeburn  9613:     }
                   9614:     if (wantarray) {
                   9615:         return ($defquota,$settingstatus);
1.472     raeburn  9616:     } else {
1.536     raeburn  9617:         return $defquota;
1.472     raeburn  9618:     }
                   9619: }
                   9620: 
1.1075.2.41  raeburn  9621: ###############################################
                   9622: 
                   9623: =pod
                   9624: 
1.1075.2.42  raeburn  9625: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  9626: 
                   9627: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  9628: of existing file within authoring space will cause quota for the authoring
                   9629: space to be exceeded.
                   9630: 
                   9631: Same, if upload of a file directly to a course/community via Course Editor
                   9632: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  9633: 
1.1075.2.61  raeburn  9634: Inputs: 7 
1.1075.2.42  raeburn  9635: 1. username or coursenum
1.1075.2.41  raeburn  9636: 2. domain
1.1075.2.42  raeburn  9637: 3. context ('author' or 'course')
1.1075.2.41  raeburn  9638: 4. filename of file for which action is being requested
                   9639: 5. filesize (kB) of file
                   9640: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  9641: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  9642: 
                   9643: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   9644:          otherwise return null.
                   9645: 
1.1075.2.42  raeburn  9646: =back
                   9647: 
1.1075.2.41  raeburn  9648: =cut
                   9649: 
1.1075.2.42  raeburn  9650: sub excess_filesize_warning {
1.1075.2.59  raeburn  9651:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  9652:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  9653:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  9654:     if ($context eq 'author') {
                   9655:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9656:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9657:     } else {
                   9658:         foreach my $subdir ('docs','supplemental') {
                   9659:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9660:         }
                   9661:     }
1.1075.2.41  raeburn  9662:     $disk_quota = int($disk_quota * 1000);
                   9663:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  9664:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  9665:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  9666:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9667:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  9668:                             $disk_quota,$current_disk_usage).
                   9669:                '</p>';
                   9670:     }
                   9671:     return;
                   9672: }
                   9673: 
                   9674: ###############################################
                   9675: 
                   9676: 
1.384     raeburn  9677: sub get_secgrprole_info {
                   9678:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9679:     my %sections_count = &get_sections($cdom,$cnum);
                   9680:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9681:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9682:     my @groups = sort(keys(%curr_groups));
                   9683:     my $allroles = [];
                   9684:     my $rolehash;
                   9685:     my $accesshash = {
                   9686:                      active => 'Currently has access',
                   9687:                      future => 'Will have future access',
                   9688:                      previous => 'Previously had access',
                   9689:                   };
                   9690:     if ($needroles) {
                   9691:         $rolehash = {'all' => 'all'};
1.385     albertel 9692:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9693: 	if (&Apache::lonnet::error(%user_roles)) {
                   9694: 	    undef(%user_roles);
                   9695: 	}
                   9696:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9697:             my ($role)=split(/\:/,$item,2);
                   9698:             if ($role eq 'cr') { next; }
                   9699:             if ($role =~ /^cr/) {
                   9700:                 $$rolehash{$role} = (split('/',$role))[3];
                   9701:             } else {
                   9702:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9703:             }
                   9704:         }
                   9705:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9706:             push(@{$allroles},$key);
                   9707:         }
                   9708:         push (@{$allroles},'st');
                   9709:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9710:     }
                   9711:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9712: }
                   9713: 
1.555     raeburn  9714: sub user_picker {
1.1075.2.127  raeburn  9715:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555     raeburn  9716:     my $currdom = $dom;
1.1075.2.114  raeburn  9717:     my @alldoms = &Apache::lonnet::all_domains();
                   9718:     if (@alldoms == 1) {
                   9719:         my %domsrch = &Apache::lonnet::get_dom('configuration',
                   9720:                                                ['directorysrch'],$alldoms[0]);
                   9721:         my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
                   9722:         my $showdom = $domdesc;
                   9723:         if ($showdom eq '') {
                   9724:             $showdom = $dom;
                   9725:         }
                   9726:         if (ref($domsrch{'directorysrch'}) eq 'HASH') {
                   9727:             if ((!$domsrch{'directorysrch'}{'available'}) &&
                   9728:                 ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   9729:                 return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
                   9730:             }
                   9731:         }
                   9732:     }
1.555     raeburn  9733:     my %curr_selected = (
                   9734:                         srchin => 'dom',
1.580     raeburn  9735:                         srchby => 'lastname',
1.555     raeburn  9736:                       );
                   9737:     my $srchterm;
1.625     raeburn  9738:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9739:         if ($srch->{'srchby'} ne '') {
                   9740:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9741:         }
                   9742:         if ($srch->{'srchin'} ne '') {
                   9743:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9744:         }
                   9745:         if ($srch->{'srchtype'} ne '') {
                   9746:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9747:         }
                   9748:         if ($srch->{'srchdomain'} ne '') {
                   9749:             $currdom = $srch->{'srchdomain'};
                   9750:         }
                   9751:         $srchterm = $srch->{'srchterm'};
                   9752:     }
1.1075.2.98  raeburn  9753:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  9754:                     'usr'       => 'Search criteria',
1.563     raeburn  9755:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9756:                     'uname'     => 'username',
                   9757:                     'lastname'  => 'last name',
1.555     raeburn  9758:                     'lastfirst' => 'last name, first name',
1.558     albertel 9759:                     'crs'       => 'in this course',
1.576     raeburn  9760:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9761:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9762:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9763:                     'exact'     => 'is',
                   9764:                     'contains'  => 'contains',
1.569     raeburn  9765:                     'begins'    => 'begins with',
1.1075.2.98  raeburn  9766:                                        );
                   9767:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  9768:                     'youm'      => "You must include some text to search for.",
                   9769:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9770:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9771:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9772:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9773:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9774:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9775:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9776:                                        );
1.1075.2.98  raeburn  9777:     &html_escape(\%html_lt);
                   9778:     &js_escape(\%js_lt);
1.1075.2.115  raeburn  9779:     my $domform;
1.1075.2.126  raeburn  9780:     my $allow_blank = 1;
1.1075.2.115  raeburn  9781:     if ($fixeddom) {
1.1075.2.126  raeburn  9782:         $allow_blank = 0;
                   9783:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1075.2.115  raeburn  9784:     } else {
1.1075.2.126  raeburn  9785:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
1.1075.2.115  raeburn  9786:     }
1.563     raeburn  9787:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9788: 
                   9789:     my @srchins = ('crs','dom','alc','instd');
                   9790: 
                   9791:     foreach my $option (@srchins) {
                   9792:         # FIXME 'alc' option unavailable until 
                   9793:         #       loncreateuser::print_user_query_page()
                   9794:         #       has been completed.
                   9795:         next if ($option eq 'alc');
1.880     raeburn  9796:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9797:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.1075.2.127  raeburn  9798:         next if (($option eq 'instd') && ($noinstd));
1.563     raeburn  9799:         if ($curr_selected{'srchin'} eq $option) {
                   9800:             $srchinsel .= ' 
1.1075.2.98  raeburn  9801:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  9802:         } else {
                   9803:             $srchinsel .= '
1.1075.2.98  raeburn  9804:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  9805:         }
1.555     raeburn  9806:     }
1.563     raeburn  9807:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9808: 
                   9809:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9810:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9811:         if ($curr_selected{'srchby'} eq $option) {
                   9812:             $srchbysel .= '
1.1075.2.98  raeburn  9813:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9814:         } else {
                   9815:             $srchbysel .= '
1.1075.2.98  raeburn  9816:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9817:          }
                   9818:     }
                   9819:     $srchbysel .= "\n  </select>\n";
                   9820: 
                   9821:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9822:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9823:         if ($curr_selected{'srchtype'} eq $option) {
                   9824:             $srchtypesel .= '
1.1075.2.98  raeburn  9825:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9826:         } else {
                   9827:             $srchtypesel .= '
1.1075.2.98  raeburn  9828:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9829:         }
                   9830:     }
                   9831:     $srchtypesel .= "\n  </select>\n";
                   9832: 
1.558     albertel 9833:     my ($newuserscript,$new_user_create);
1.994     raeburn  9834:     my $context_dom = $env{'request.role.domain'};
                   9835:     if ($context eq 'requestcrs') {
                   9836:         if ($env{'form.coursedom'} ne '') { 
                   9837:             $context_dom = $env{'form.coursedom'};
                   9838:         }
                   9839:     }
1.556     raeburn  9840:     if ($forcenewuser) {
1.576     raeburn  9841:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9842:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9843:                 if ($cancreate) {
                   9844:                     $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>';
                   9845:                 } else {
1.799     bisitz   9846:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9847:                     my %usertypetext = (
                   9848:                         official   => 'institutional',
                   9849:                         unofficial => 'non-institutional',
                   9850:                     );
1.799     bisitz   9851:                     $new_user_create = '<p class="LC_warning">'
                   9852:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9853:                                       .' '
                   9854:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9855:                                           ,'<a href="'.$helplink.'">','</a>')
                   9856:                                       .'</p><br />';
1.627     raeburn  9857:                 }
1.576     raeburn  9858:             }
                   9859:         }
                   9860: 
1.556     raeburn  9861:         $newuserscript = <<"ENDSCRIPT";
                   9862: 
1.570     raeburn  9863: function setSearch(createnew,callingForm) {
1.556     raeburn  9864:     if (createnew == 1) {
1.570     raeburn  9865:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9866:             if (callingForm.srchby.options[i].value == 'uname') {
                   9867:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9868:             }
                   9869:         }
1.570     raeburn  9870:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9871:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9872: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9873:             }
                   9874:         }
1.570     raeburn  9875:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9876:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9877:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9878:             }
                   9879:         }
1.570     raeburn  9880:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9881:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9882:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9883:             }
                   9884:         }
                   9885:     }
                   9886: }
                   9887: ENDSCRIPT
1.558     albertel 9888: 
1.556     raeburn  9889:     }
                   9890: 
1.555     raeburn  9891:     my $output = <<"END_BLOCK";
1.556     raeburn  9892: <script type="text/javascript">
1.824     bisitz   9893: // <![CDATA[
1.570     raeburn  9894: function validateEntry(callingForm) {
1.558     albertel 9895: 
1.556     raeburn  9896:     var checkok = 1;
1.558     albertel 9897:     var srchin;
1.570     raeburn  9898:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9899: 	if ( callingForm.srchin[i].checked ) {
                   9900: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9901: 	}
                   9902:     }
                   9903: 
1.570     raeburn  9904:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9905:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9906:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9907:     var srchterm =  callingForm.srchterm.value;
                   9908:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9909:     var msg = "";
                   9910: 
                   9911:     if (srchterm == "") {
                   9912:         checkok = 0;
1.1075.2.98  raeburn  9913:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  9914:     }
                   9915: 
1.569     raeburn  9916:     if (srchtype== 'begins') {
                   9917:         if (srchterm.length < 2) {
                   9918:             checkok = 0;
1.1075.2.98  raeburn  9919:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  9920:         }
                   9921:     }
                   9922: 
1.556     raeburn  9923:     if (srchtype== 'contains') {
                   9924:         if (srchterm.length < 3) {
                   9925:             checkok = 0;
1.1075.2.98  raeburn  9926:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  9927:         }
                   9928:     }
                   9929:     if (srchin == 'instd') {
                   9930:         if (srchdomain == '') {
                   9931:             checkok = 0;
1.1075.2.98  raeburn  9932:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  9933:         }
                   9934:     }
                   9935:     if (srchin == 'dom') {
                   9936:         if (srchdomain == '') {
                   9937:             checkok = 0;
1.1075.2.98  raeburn  9938:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  9939:         }
                   9940:     }
                   9941:     if (srchby == 'lastfirst') {
                   9942:         if (srchterm.indexOf(",") == -1) {
                   9943:             checkok = 0;
1.1075.2.98  raeburn  9944:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  9945:         }
                   9946:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9947:             checkok = 0;
1.1075.2.98  raeburn  9948:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  9949:         }
                   9950:     }
                   9951:     if (checkok == 0) {
1.1075.2.98  raeburn  9952:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  9953:         return;
                   9954:     }
                   9955:     if (checkok == 1) {
1.570     raeburn  9956:         callingForm.submit();
1.556     raeburn  9957:     }
                   9958: }
                   9959: 
                   9960: $newuserscript
                   9961: 
1.824     bisitz   9962: // ]]>
1.556     raeburn  9963: </script>
1.558     albertel 9964: 
                   9965: $new_user_create
                   9966: 
1.555     raeburn  9967: END_BLOCK
1.558     albertel 9968: 
1.876     raeburn  9969:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98  raeburn  9970:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  9971:                $domform.
                   9972:                &Apache::lonhtmlcommon::row_closure().
1.1075.2.98  raeburn  9973:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  9974:                $srchbysel.
                   9975:                $srchtypesel. 
                   9976:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9977:                $srchinsel.
                   9978:                &Apache::lonhtmlcommon::row_closure(1). 
                   9979:                &Apache::lonhtmlcommon::end_pick_box().
                   9980:                '<br />';
1.1075.2.114  raeburn  9981:     return ($output,1);
1.555     raeburn  9982: }
                   9983: 
1.612     raeburn  9984: sub user_rule_check {
1.615     raeburn  9985:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99  raeburn  9986:     my ($response,%inst_response);
1.612     raeburn  9987:     if (ref($usershash) eq 'HASH') {
1.1075.2.99  raeburn  9988:         if (keys(%{$usershash}) > 1) {
                   9989:             my (%by_username,%by_id,%userdoms);
                   9990:             my $checkid;
1.612     raeburn  9991:             if (ref($checks) eq 'HASH') {
1.1075.2.99  raeburn  9992:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   9993:                     $checkid = 1;
                   9994:                 }
                   9995:             }
                   9996:             foreach my $user (keys(%{$usershash})) {
                   9997:                 my ($uname,$udom) = split(/:/,$user);
                   9998:                 if ($checkid) {
                   9999:                     if (ref($usershash->{$user}) eq 'HASH') {
                   10000:                         if ($usershash->{$user}->{'id'} ne '') {
                   10001:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
                   10002:                             $userdoms{$udom} = 1;
                   10003:                             if (ref($inst_results) eq 'HASH') {
                   10004:                                 $inst_results->{$uname.':'.$udom} = {};
                   10005:                             }
                   10006:                         }
                   10007:                     }
                   10008:                 } else {
                   10009:                     $by_username{$udom}{$uname} = 1;
                   10010:                     $userdoms{$udom} = 1;
                   10011:                     if (ref($inst_results) eq 'HASH') {
                   10012:                         $inst_results->{$uname.':'.$udom} = {};
                   10013:                     }
                   10014:                 }
                   10015:             }
                   10016:             foreach my $udom (keys(%userdoms)) {
                   10017:                 if (!$got_rules->{$udom}) {
                   10018:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10019:                                                              ['usercreation'],$udom);
                   10020:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10021:                         foreach my $item ('username','id') {
                   10022:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10023:                                 $$curr_rules{$udom}{$item} =
                   10024:                                     $domconfig{'usercreation'}{$item.'_rule'};
                   10025:                             }
                   10026:                         }
                   10027:                     }
                   10028:                     $got_rules->{$udom} = 1;
                   10029:                 }
                   10030:             }
                   10031:             if ($checkid) {
                   10032:                 foreach my $udom (keys(%by_id)) {
                   10033:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   10034:                     if ($outcome eq 'ok') {
                   10035:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   10036:                             my $uname = $by_id{$udom}{$id};
                   10037:                             $inst_response{$uname.':'.$udom} = $outcome;
                   10038:                         }
                   10039:                         if (ref($results) eq 'HASH') {
                   10040:                             foreach my $uname (keys(%{$results})) {
                   10041:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   10042:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   10043:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   10044:                                 }
                   10045:                             }
                   10046:                         }
                   10047:                     }
1.612     raeburn  10048:                 }
1.615     raeburn  10049:             } else {
1.1075.2.99  raeburn  10050:                 foreach my $udom (keys(%by_username)) {
                   10051:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   10052:                     if ($outcome eq 'ok') {
                   10053:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   10054:                             $inst_response{$uname.':'.$udom} = $outcome;
                   10055:                         }
                   10056:                         if (ref($results) eq 'HASH') {
                   10057:                             foreach my $uname (keys(%{$results})) {
                   10058:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   10059:                             }
                   10060:                         }
                   10061:                     }
                   10062:                 }
1.612     raeburn  10063:             }
1.1075.2.99  raeburn  10064:         } elsif (keys(%{$usershash}) == 1) {
                   10065:             my $user = (keys(%{$usershash}))[0];
                   10066:             my ($uname,$udom) = split(/:/,$user);
                   10067:             if (($udom ne '') && ($uname ne '')) {
                   10068:                 if (ref($usershash->{$user}) eq 'HASH') {
                   10069:                     if (ref($checks) eq 'HASH') {
                   10070:                         if (defined($checks->{'username'})) {
                   10071:                             ($inst_response{$user},%{$inst_results->{$user}}) =
                   10072:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   10073:                         } elsif (defined($checks->{'id'})) {
                   10074:                             if ($usershash->{$user}->{'id'} ne '') {
                   10075:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10076:                                     &Apache::lonnet::get_instuser($udom,undef,
                   10077:                                                                   $usershash->{$user}->{'id'});
                   10078:                             } else {
                   10079:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10080:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   10081:                             }
                   10082:                         }
                   10083:                     } else {
                   10084:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   10085:                             &Apache::lonnet::get_instuser($udom,$uname);
                   10086:                        return;
                   10087:                     }
                   10088:                     if (!$got_rules->{$udom}) {
                   10089:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10090:                                                                  ['usercreation'],$udom);
                   10091:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10092:                             foreach my $item ('username','id') {
                   10093:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10094:                                    $$curr_rules{$udom}{$item} =
                   10095:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   10096:                                 }
                   10097:                             }
1.585     raeburn  10098:                         }
1.1075.2.99  raeburn  10099:                         $got_rules->{$udom} = 1;
1.585     raeburn  10100:                     }
                   10101:                 }
1.1075.2.99  raeburn  10102:             } else {
                   10103:                 return;
                   10104:             }
                   10105:         } else {
                   10106:             return;
                   10107:         }
                   10108:         foreach my $user (keys(%{$usershash})) {
                   10109:             my ($uname,$udom) = split(/:/,$user);
                   10110:             next if (($udom eq '') || ($uname eq ''));
                   10111:             my $id;
                   10112:             if (ref($inst_results) eq 'HASH') {
                   10113:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   10114:                     $id = $inst_results->{$user}->{'id'};
                   10115:                 }
                   10116:             }
                   10117:             if ($id eq '') {
                   10118:                 if (ref($usershash->{$user})) {
                   10119:                     $id = $usershash->{$user}->{'id'};
                   10120:                 }
1.585     raeburn  10121:             }
1.612     raeburn  10122:             foreach my $item (keys(%{$checks})) {
                   10123:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   10124:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   10125:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99  raeburn  10126:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   10127:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  10128:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   10129:                                 if ($rule_check{$rule}) {
                   10130:                                     $$rulematch{$user}{$item} = $rule;
1.1075.2.99  raeburn  10131:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  10132:                                         if (ref($inst_results) eq 'HASH') {
                   10133:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   10134:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   10135:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99  raeburn  10136:                                                 } elsif ($item eq 'id') {
                   10137:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   10138:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   10139:                                                     }
1.615     raeburn  10140:                                                 }
1.612     raeburn  10141:                                             }
                   10142:                                         }
1.615     raeburn  10143:                                     }
                   10144:                                     last;
1.585     raeburn  10145:                                 }
                   10146:                             }
                   10147:                         }
                   10148:                     }
                   10149:                 }
                   10150:             }
                   10151:         }
                   10152:     }
1.612     raeburn  10153:     return;
                   10154: }
                   10155: 
                   10156: sub user_rule_formats {
                   10157:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   10158:     my %text = ( 
                   10159:                  'username' => 'Usernames',
                   10160:                  'id'       => 'IDs',
                   10161:                );
                   10162:     my $output;
                   10163:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   10164:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   10165:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  10166:             $output = '<br />'.
                   10167:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   10168:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   10169:                       ' <ul>';
1.612     raeburn  10170:             foreach my $rule (@{$ruleorder}) {
                   10171:                 if (ref($curr_rules) eq 'ARRAY') {
                   10172:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   10173:                         if (ref($rules->{$rule}) eq 'HASH') {
                   10174:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   10175:                                         $rules->{$rule}{'desc'}.'</li>';
                   10176:                         }
                   10177:                     }
                   10178:                 }
                   10179:             }
                   10180:             $output .= '</ul>';
                   10181:         }
                   10182:     }
                   10183:     return $output;
                   10184: }
                   10185: 
                   10186: sub instrule_disallow_msg {
1.615     raeburn  10187:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  10188:     my $response;
                   10189:     my %text = (
                   10190:                   item   => 'username',
                   10191:                   items  => 'usernames',
                   10192:                   match  => 'matches',
                   10193:                   do     => 'does',
                   10194:                   action => 'a username',
                   10195:                   one    => 'one',
                   10196:                );
                   10197:     if ($count > 1) {
                   10198:         $text{'item'} = 'usernames';
                   10199:         $text{'match'} ='match';
                   10200:         $text{'do'} = 'do';
                   10201:         $text{'action'} = 'usernames',
                   10202:         $text{'one'} = 'ones';
                   10203:     }
                   10204:     if ($checkitem eq 'id') {
                   10205:         $text{'items'} = 'IDs';
                   10206:         $text{'item'} = 'ID';
                   10207:         $text{'action'} = 'an ID';
1.615     raeburn  10208:         if ($count > 1) {
                   10209:             $text{'item'} = 'IDs';
                   10210:             $text{'action'} = 'IDs';
                   10211:         }
1.612     raeburn  10212:     }
1.674     bisitz   10213:     $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  10214:     if ($mode eq 'upload') {
                   10215:         if ($checkitem eq 'username') {
                   10216:             $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'}.");
                   10217:         } elsif ($checkitem eq 'id') {
1.674     bisitz   10218:             $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  10219:         }
1.669     raeburn  10220:     } elsif ($mode eq 'selfcreate') {
                   10221:         if ($checkitem eq 'id') {
                   10222:             $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.");
                   10223:         }
1.615     raeburn  10224:     } else {
                   10225:         if ($checkitem eq 'username') {
                   10226:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   10227:         } elsif ($checkitem eq 'id') {
                   10228:             $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.");
                   10229:         }
1.612     raeburn  10230:     }
                   10231:     return $response;
1.585     raeburn  10232: }
                   10233: 
1.624     raeburn  10234: sub personal_data_fieldtitles {
                   10235:     my %fieldtitles = &Apache::lonlocal::texthash (
                   10236:                         id => 'Student/Employee ID',
                   10237:                         permanentemail => 'E-mail address',
                   10238:                         lastname => 'Last Name',
                   10239:                         firstname => 'First Name',
                   10240:                         middlename => 'Middle Name',
                   10241:                         generation => 'Generation',
                   10242:                         gen => 'Generation',
1.765     raeburn  10243:                         inststatus => 'Affiliation',
1.624     raeburn  10244:                    );
                   10245:     return %fieldtitles;
                   10246: }
                   10247: 
1.642     raeburn  10248: sub sorted_inst_types {
                   10249:     my ($dom) = @_;
1.1075.2.70  raeburn  10250:     my ($usertypes,$order);
                   10251:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   10252:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   10253:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   10254:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   10255:     } else {
                   10256:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   10257:     }
1.642     raeburn  10258:     my $othertitle = &mt('All users');
                   10259:     if ($env{'request.course.id'}) {
1.668     raeburn  10260:         $othertitle  = &mt('Any users');
1.642     raeburn  10261:     }
                   10262:     my @types;
                   10263:     if (ref($order) eq 'ARRAY') {
                   10264:         @types = @{$order};
                   10265:     }
                   10266:     if (@types == 0) {
                   10267:         if (ref($usertypes) eq 'HASH') {
                   10268:             @types = sort(keys(%{$usertypes}));
                   10269:         }
                   10270:     }
                   10271:     if (keys(%{$usertypes}) > 0) {
                   10272:         $othertitle = &mt('Other users');
                   10273:     }
                   10274:     return ($othertitle,$usertypes,\@types);
                   10275: }
                   10276: 
1.645     raeburn  10277: sub get_institutional_codes {
                   10278:     my ($settings,$allcourses,$LC_code) = @_;
                   10279: # Get complete list of course sections to update
                   10280:     my @currsections = ();
                   10281:     my @currxlists = ();
                   10282:     my $coursecode = $$settings{'internal.coursecode'};
                   10283: 
                   10284:     if ($$settings{'internal.sectionnums'} ne '') {
                   10285:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   10286:     }
                   10287: 
                   10288:     if ($$settings{'internal.crosslistings'} ne '') {
                   10289:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   10290:     }
                   10291: 
                   10292:     if (@currxlists > 0) {
                   10293:         foreach (@currxlists) {
                   10294:             if (m/^([^:]+):(\w*)$/) {
                   10295:                 unless (grep/^$1$/,@{$allcourses}) {
1.1075.2.119  raeburn  10296:                     push(@{$allcourses},$1);
1.645     raeburn  10297:                     $$LC_code{$1} = $2;
                   10298:                 }
                   10299:             }
                   10300:         }
                   10301:     }
                   10302:  
                   10303:     if (@currsections > 0) {
                   10304:         foreach (@currsections) {
                   10305:             if (m/^(\w+):(\w*)$/) {
                   10306:                 my $sec = $coursecode.$1;
                   10307:                 my $lc_sec = $2;
                   10308:                 unless (grep/^$sec$/,@{$allcourses}) {
1.1075.2.119  raeburn  10309:                     push(@{$allcourses},$sec);
1.645     raeburn  10310:                     $$LC_code{$sec} = $lc_sec;
                   10311:                 }
                   10312:             }
                   10313:         }
                   10314:     }
                   10315:     return;
                   10316: }
                   10317: 
1.971     raeburn  10318: sub get_standard_codeitems {
                   10319:     return ('Year','Semester','Department','Number','Section');
                   10320: }
                   10321: 
1.112     bowersj2 10322: =pod
                   10323: 
1.780     raeburn  10324: =head1 Slot Helpers
                   10325: 
                   10326: =over 4
                   10327: 
                   10328: =item * sorted_slots()
                   10329: 
1.1040    raeburn  10330: Sorts an array of slot names in order of an optional sort key,
                   10331: default sort is by slot start time (earliest first). 
1.780     raeburn  10332: 
                   10333: Inputs:
                   10334: 
                   10335: =over 4
                   10336: 
                   10337: slotsarr  - Reference to array of unsorted slot names.
                   10338: 
                   10339: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   10340: 
1.1040    raeburn  10341: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   10342: 
1.549     albertel 10343: =back
                   10344: 
1.780     raeburn  10345: Returns:
                   10346: 
                   10347: =over 4
                   10348: 
1.1040    raeburn  10349: sorted   - An array of slot names sorted by a specified sort key 
                   10350:            (default sort key is start time of the slot).
1.780     raeburn  10351: 
                   10352: =back
                   10353: 
                   10354: =cut
                   10355: 
                   10356: 
                   10357: sub sorted_slots {
1.1040    raeburn  10358:     my ($slotsarr,$slots,$sortkey) = @_;
                   10359:     if ($sortkey eq '') {
                   10360:         $sortkey = 'starttime';
                   10361:     }
1.780     raeburn  10362:     my @sorted;
                   10363:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   10364:         @sorted =
                   10365:             sort {
                   10366:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  10367:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  10368:                      }
                   10369:                      if (ref($slots->{$a})) { return -1;}
                   10370:                      if (ref($slots->{$b})) { return 1;}
                   10371:                      return 0;
                   10372:                  } @{$slotsarr};
                   10373:     }
                   10374:     return @sorted;
                   10375: }
                   10376: 
1.1040    raeburn  10377: =pod
                   10378: 
                   10379: =item * get_future_slots()
                   10380: 
                   10381: Inputs:
                   10382: 
                   10383: =over 4
                   10384: 
                   10385: cnum - course number
                   10386: 
                   10387: cdom - course domain
                   10388: 
                   10389: now - current UNIX time
                   10390: 
                   10391: symb - optional symb
                   10392: 
                   10393: =back
                   10394: 
                   10395: Returns:
                   10396: 
                   10397: =over 4
                   10398: 
                   10399: sorted_reservable - ref to array of student_schedulable slots currently 
                   10400:                     reservable, ordered by end date of reservation period.
                   10401: 
                   10402: reservable_now - ref to hash of student_schedulable slots currently
                   10403:                  reservable.
                   10404: 
                   10405:     Keys in inner hash are:
                   10406:     (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104  raeburn  10407:     (b) endreserve: end date of reservation period.
                   10408:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   10409:         selected.
1.1040    raeburn  10410: 
                   10411: sorted_future - ref to array of student_schedulable slots reservable in
                   10412:                 the future, ordered by start date of reservation period.
                   10413: 
                   10414: future_reservable - ref to hash of student_schedulable slots reservable
                   10415:                     in the future.
                   10416: 
                   10417:     Keys in inner hash are:
                   10418:     (a) symb: either blank or symb to which slot use is restricted.
                   10419:     (b) startreserve:  start date of reservation period.
1.1075.2.104  raeburn  10420:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   10421:         selected.
1.1040    raeburn  10422: 
                   10423: =back
                   10424: 
                   10425: =cut
                   10426: 
                   10427: sub get_future_slots {
                   10428:     my ($cnum,$cdom,$now,$symb) = @_;
                   10429:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   10430:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   10431:     foreach my $slot (keys(%slots)) {
                   10432:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   10433:         if ($symb) {
                   10434:             next if (($slots{$slot}->{'symb'} ne '') && 
                   10435:                      ($slots{$slot}->{'symb'} ne $symb));
                   10436:         }
                   10437:         if (($slots{$slot}->{'starttime'} > $now) &&
                   10438:             ($slots{$slot}->{'endtime'} > $now)) {
                   10439:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   10440:                 my $userallowed = 0;
                   10441:                 if ($slots{$slot}->{'allowedsections'}) {
                   10442:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   10443:                     if (!defined($env{'request.role.sec'})
                   10444:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   10445:                         $userallowed=1;
                   10446:                     } else {
                   10447:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   10448:                             $userallowed=1;
                   10449:                         }
                   10450:                     }
                   10451:                     unless ($userallowed) {
                   10452:                         if (defined($env{'request.course.groups'})) {
                   10453:                             my @groups = split(/:/,$env{'request.course.groups'});
                   10454:                             foreach my $group (@groups) {
                   10455:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   10456:                                     $userallowed=1;
                   10457:                                     last;
                   10458:                                 }
                   10459:                             }
                   10460:                         }
                   10461:                     }
                   10462:                 }
                   10463:                 if ($slots{$slot}->{'allowedusers'}) {
                   10464:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   10465:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   10466:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   10467:                         $userallowed = 1;
                   10468:                     }
                   10469:                 }
                   10470:                 next unless($userallowed);
                   10471:             }
                   10472:             my $startreserve = $slots{$slot}->{'startreserve'};
                   10473:             my $endreserve = $slots{$slot}->{'endreserve'};
                   10474:             my $symb = $slots{$slot}->{'symb'};
1.1075.2.104  raeburn  10475:             my $uniqueperiod;
                   10476:             if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   10477:                 $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
                   10478:             }
1.1040    raeburn  10479:             if (($startreserve < $now) &&
                   10480:                 (!$endreserve || $endreserve > $now)) {
                   10481:                 my $lastres = $endreserve;
                   10482:                 if (!$lastres) {
                   10483:                     $lastres = $slots{$slot}->{'starttime'};
                   10484:                 }
                   10485:                 $reservable_now{$slot} = {
                   10486:                                            symb       => $symb,
1.1075.2.104  raeburn  10487:                                            endreserve => $lastres,
                   10488:                                            uniqueperiod => $uniqueperiod,   
1.1040    raeburn  10489:                                          };
                   10490:             } elsif (($startreserve > $now) &&
                   10491:                      (!$endreserve || $endreserve > $startreserve)) {
                   10492:                 $future_reservable{$slot} = {
                   10493:                                               symb         => $symb,
1.1075.2.104  raeburn  10494:                                               startreserve => $startreserve,
                   10495:                                               uniqueperiod => $uniqueperiod,
1.1040    raeburn  10496:                                             };
                   10497:             }
                   10498:         }
                   10499:     }
                   10500:     my @unsorted_reservable = keys(%reservable_now);
                   10501:     if (@unsorted_reservable > 0) {
                   10502:         @sorted_reservable = 
                   10503:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   10504:     }
                   10505:     my @unsorted_future = keys(%future_reservable);
                   10506:     if (@unsorted_future > 0) {
                   10507:         @sorted_future =
                   10508:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   10509:     }
                   10510:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   10511: }
1.780     raeburn  10512: 
                   10513: =pod
                   10514: 
1.1057    foxr     10515: =back
                   10516: 
1.549     albertel 10517: =head1 HTTP Helpers
                   10518: 
                   10519: =over 4
                   10520: 
1.648     raeburn  10521: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 10522: 
1.258     albertel 10523: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 10524: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 10525: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 10526: 
                   10527: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   10528: $possible_names is an ref to an array of form element names.  As an example:
                   10529: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 10530: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 10531: 
                   10532: =cut
1.1       albertel 10533: 
1.6       albertel 10534: sub get_unprocessed_cgi {
1.25      albertel 10535:   my ($query,$possible_names)= @_;
1.26      matthew  10536:   # $Apache::lonxml::debug=1;
1.356     albertel 10537:   foreach my $pair (split(/&/,$query)) {
                   10538:     my ($name, $value) = split(/=/,$pair);
1.369     www      10539:     $name = &unescape($name);
1.25      albertel 10540:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   10541:       $value =~ tr/+/ /;
                   10542:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10543:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10544:     }
1.16      harris41 10545:   }
1.6       albertel 10546: }
                   10547: 
1.112     bowersj2 10548: =pod
                   10549: 
1.648     raeburn  10550: =item * &cacheheader() 
1.112     bowersj2 10551: 
                   10552: returns cache-controlling header code
                   10553: 
                   10554: =cut
                   10555: 
1.7       albertel 10556: sub cacheheader {
1.258     albertel 10557:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10558:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10559:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10560:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10561:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10562:     return $output;
1.7       albertel 10563: }
                   10564: 
1.112     bowersj2 10565: =pod
                   10566: 
1.648     raeburn  10567: =item * &no_cache($r) 
1.112     bowersj2 10568: 
                   10569: specifies header code to not have cache
                   10570: 
                   10571: =cut
                   10572: 
1.9       albertel 10573: sub no_cache {
1.216     albertel 10574:     my ($r) = @_;
                   10575:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10576: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10577:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10578:     $r->no_cache(1);
                   10579:     $r->header_out("Expires" => $date);
                   10580:     $r->header_out("Pragma" => "no-cache");
1.123     www      10581: }
                   10582: 
                   10583: sub content_type {
1.181     albertel 10584:     my ($r,$type,$charset) = @_;
1.299     foxr     10585:     if ($r) {
                   10586: 	#  Note that printout.pl calls this with undef for $r.
                   10587: 	&no_cache($r);
                   10588:     }
1.258     albertel 10589:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10590:     unless ($charset) {
                   10591: 	$charset=&Apache::lonlocal::current_encoding;
                   10592:     }
                   10593:     if ($charset) { $type.='; charset='.$charset; }
                   10594:     if ($r) {
                   10595: 	$r->content_type($type);
                   10596:     } else {
                   10597: 	print("Content-type: $type\n\n");
                   10598:     }
1.9       albertel 10599: }
1.25      albertel 10600: 
1.112     bowersj2 10601: =pod
                   10602: 
1.648     raeburn  10603: =item * &add_to_env($name,$value) 
1.112     bowersj2 10604: 
1.258     albertel 10605: adds $name to the %env hash with value
1.112     bowersj2 10606: $value, if $name already exists, the entry is converted to an array
                   10607: reference and $value is added to the array.
                   10608: 
                   10609: =cut
                   10610: 
1.25      albertel 10611: sub add_to_env {
                   10612:   my ($name,$value)=@_;
1.258     albertel 10613:   if (defined($env{$name})) {
                   10614:     if (ref($env{$name})) {
1.25      albertel 10615:       #already have multiple values
1.258     albertel 10616:       push(@{ $env{$name} },$value);
1.25      albertel 10617:     } else {
                   10618:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 10619:       my $first=$env{$name};
                   10620:       undef($env{$name});
                   10621:       push(@{ $env{$name} },$first,$value);
1.25      albertel 10622:     }
                   10623:   } else {
1.258     albertel 10624:     $env{$name}=$value;
1.25      albertel 10625:   }
1.31      albertel 10626: }
1.149     albertel 10627: 
                   10628: =pod
                   10629: 
1.648     raeburn  10630: =item * &get_env_multiple($name) 
1.149     albertel 10631: 
1.258     albertel 10632: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 10633: values may be defined and end up as an array ref.
                   10634: 
                   10635: returns an array of values
                   10636: 
                   10637: =cut
                   10638: 
                   10639: sub get_env_multiple {
                   10640:     my ($name) = @_;
                   10641:     my @values;
1.258     albertel 10642:     if (defined($env{$name})) {
1.149     albertel 10643:         # exists is it an array
1.258     albertel 10644:         if (ref($env{$name})) {
                   10645:             @values=@{ $env{$name} };
1.149     albertel 10646:         } else {
1.258     albertel 10647:             $values[0]=$env{$name};
1.149     albertel 10648:         }
                   10649:     }
                   10650:     return(@values);
                   10651: }
                   10652: 
1.660     raeburn  10653: sub ask_for_embedded_content {
                   10654:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  10655:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  10656:         %currsubfile,%unused,$rem);
1.1071    raeburn  10657:     my $counter = 0;
                   10658:     my $numnew = 0;
1.987     raeburn  10659:     my $numremref = 0;
                   10660:     my $numinvalid = 0;
                   10661:     my $numpathchg = 0;
                   10662:     my $numexisting = 0;
1.1071    raeburn  10663:     my $numunused = 0;
                   10664:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  10665:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  10666:     my $heading = &mt('Upload embedded files');
                   10667:     my $buttontext = &mt('Upload');
                   10668: 
1.1075.2.11  raeburn  10669:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  10670:         if ($actionurl eq '/adm/dependencies') {
                   10671:             $navmap = Apache::lonnavmaps::navmap->new();
                   10672:         }
                   10673:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   10674:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  10675:     }
1.1075.2.35  raeburn  10676:     if (($actionurl eq '/adm/portfolio') ||
                   10677:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  10678:         my $current_path='/';
                   10679:         if ($env{'form.currentpath'}) {
                   10680:             $current_path = $env{'form.currentpath'};
                   10681:         }
                   10682:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  10683:             $udom = $cdom;
                   10684:             $uname = $cnum;
1.984     raeburn  10685:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   10686:         } else {
                   10687:             $udom = $env{'user.domain'};
                   10688:             $uname = $env{'user.name'};
                   10689:             $url = '/userfiles/portfolio';
                   10690:         }
1.987     raeburn  10691:         $toplevel = $url.'/';
1.984     raeburn  10692:         $url .= $current_path;
                   10693:         $getpropath = 1;
1.987     raeburn  10694:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   10695:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      10696:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  10697:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  10698:         $toplevel = $url;
1.984     raeburn  10699:         if ($rest ne '') {
1.987     raeburn  10700:             $url .= $rest;
                   10701:         }
                   10702:     } elsif ($actionurl eq '/adm/coursedocs') {
                   10703:         if (ref($args) eq 'HASH') {
1.1071    raeburn  10704:             $url = $args->{'docs_url'};
                   10705:             $toplevel = $url;
1.1075.2.11  raeburn  10706:             if ($args->{'context'} eq 'paste') {
                   10707:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   10708:                 ($path) =
                   10709:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10710:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10711:                 $fileloc =~ s{^/}{};
                   10712:             }
1.1071    raeburn  10713:         }
                   10714:     } elsif ($actionurl eq '/adm/dependencies') {
                   10715:         if ($env{'request.course.id'} ne '') {
                   10716:             if (ref($args) eq 'HASH') {
                   10717:                 $url = $args->{'docs_url'};
                   10718:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  10719:                 $toplevel = $url;
                   10720:                 unless ($toplevel =~ m{^/}) {
                   10721:                     $toplevel = "/$url";
                   10722:                 }
1.1075.2.11  raeburn  10723:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  10724:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   10725:                     $path = $1;
                   10726:                 } else {
                   10727:                     ($path) =
                   10728:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10729:                 }
1.1075.2.79  raeburn  10730:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   10731:                     $fileloc = $toplevel;
                   10732:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   10733:                     my ($udom,$uname,$fname) =
                   10734:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   10735:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   10736:                 } else {
                   10737:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10738:                 }
1.1071    raeburn  10739:                 $fileloc =~ s{^/}{};
                   10740:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   10741:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   10742:             }
1.987     raeburn  10743:         }
1.1075.2.35  raeburn  10744:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10745:         $udom = $cdom;
                   10746:         $uname = $cnum;
                   10747:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   10748:         $toplevel = $url;
                   10749:         $path = $url;
                   10750:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   10751:         $fileloc =~ s{^/}{};
                   10752:     }
                   10753:     foreach my $file (keys(%{$allfiles})) {
                   10754:         my $embed_file;
                   10755:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   10756:             $embed_file = $1;
                   10757:         } else {
                   10758:             $embed_file = $file;
                   10759:         }
1.1075.2.55  raeburn  10760:         my ($absolutepath,$cleaned_file);
                   10761:         if ($embed_file =~ m{^\w+://}) {
                   10762:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  10763:             $newfiles{$cleaned_file} = 1;
                   10764:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10765:         } else {
1.1075.2.55  raeburn  10766:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  10767:             if ($embed_file =~ m{^/}) {
                   10768:                 $absolutepath = $embed_file;
                   10769:             }
1.1075.2.47  raeburn  10770:             if ($cleaned_file =~ m{/}) {
                   10771:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  10772:                 $path = &check_for_traversal($path,$url,$toplevel);
                   10773:                 my $item = $fname;
                   10774:                 if ($path ne '') {
                   10775:                     $item = $path.'/'.$fname;
                   10776:                     $subdependencies{$path}{$fname} = 1;
                   10777:                 } else {
                   10778:                     $dependencies{$item} = 1;
                   10779:                 }
                   10780:                 if ($absolutepath) {
                   10781:                     $mapping{$item} = $absolutepath;
                   10782:                 } else {
                   10783:                     $mapping{$item} = $embed_file;
                   10784:                 }
                   10785:             } else {
                   10786:                 $dependencies{$embed_file} = 1;
                   10787:                 if ($absolutepath) {
1.1075.2.47  raeburn  10788:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  10789:                 } else {
1.1075.2.47  raeburn  10790:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10791:                 }
                   10792:             }
1.984     raeburn  10793:         }
                   10794:     }
1.1071    raeburn  10795:     my $dirptr = 16384;
1.984     raeburn  10796:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  10797:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  10798:         if (($actionurl eq '/adm/portfolio') ||
                   10799:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  10800:             my ($sublistref,$listerror) =
                   10801:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   10802:             if (ref($sublistref) eq 'ARRAY') {
                   10803:                 foreach my $line (@{$sublistref}) {
                   10804:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  10805:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  10806:                 }
1.984     raeburn  10807:             }
1.987     raeburn  10808:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10809:             if (opendir(my $dir,$url.'/'.$path)) {
                   10810:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  10811:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   10812:             }
1.1075.2.11  raeburn  10813:         } elsif (($actionurl eq '/adm/dependencies') ||
                   10814:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10815:                   ($args->{'context'} eq 'paste')) ||
                   10816:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10817:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  10818:                 my $dir;
                   10819:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10820:                     $dir = $fileloc;
                   10821:                 } else {
                   10822:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10823:                 }
1.1071    raeburn  10824:                 if ($dir ne '') {
                   10825:                     my ($sublistref,$listerror) =
                   10826:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10827:                     if (ref($sublistref) eq 'ARRAY') {
                   10828:                         foreach my $line (@{$sublistref}) {
                   10829:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10830:                                 undef,$mtime)=split(/\&/,$line,12);
                   10831:                             unless (($testdir&$dirptr) ||
                   10832:                                     ($file_name =~ /^\.\.?$/)) {
                   10833:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10834:                             }
                   10835:                         }
                   10836:                     }
                   10837:                 }
1.984     raeburn  10838:             }
                   10839:         }
                   10840:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10841:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10842:                 my $item = $path.'/'.$file;
                   10843:                 unless ($mapping{$item} eq $item) {
                   10844:                     $pathchanges{$item} = 1;
                   10845:                 }
                   10846:                 $existing{$item} = 1;
                   10847:                 $numexisting ++;
                   10848:             } else {
                   10849:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10850:             }
                   10851:         }
1.1071    raeburn  10852:         if ($actionurl eq '/adm/dependencies') {
                   10853:             foreach my $path (keys(%currsubfile)) {
                   10854:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10855:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10856:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  10857:                              next if (($rem ne '') &&
                   10858:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10859:                                        (ref($navmap) &&
                   10860:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10861:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10862:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10863:                              $unused{$path.'/'.$file} = 1; 
                   10864:                          }
                   10865:                     }
                   10866:                 }
                   10867:             }
                   10868:         }
1.984     raeburn  10869:     }
1.987     raeburn  10870:     my %currfile;
1.1075.2.35  raeburn  10871:     if (($actionurl eq '/adm/portfolio') ||
                   10872:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10873:         my ($dirlistref,$listerror) =
                   10874:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10875:         if (ref($dirlistref) eq 'ARRAY') {
                   10876:             foreach my $line (@{$dirlistref}) {
                   10877:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10878:                 $currfile{$file_name} = 1;
                   10879:             }
1.984     raeburn  10880:         }
1.987     raeburn  10881:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10882:         if (opendir(my $dir,$url)) {
1.987     raeburn  10883:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10884:             map {$currfile{$_} = 1;} @dir_list;
                   10885:         }
1.1075.2.11  raeburn  10886:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10887:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10888:               ($args->{'context'} eq 'paste')) ||
                   10889:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10890:         if ($env{'request.course.id'} ne '') {
                   10891:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10892:             if ($dir ne '') {
                   10893:                 my ($dirlistref,$listerror) =
                   10894:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10895:                 if (ref($dirlistref) eq 'ARRAY') {
                   10896:                     foreach my $line (@{$dirlistref}) {
                   10897:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10898:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10899:                         unless (($testdir&$dirptr) ||
                   10900:                                 ($file_name =~ /^\.\.?$/)) {
                   10901:                             $currfile{$file_name} = [$size,$mtime];
                   10902:                         }
                   10903:                     }
                   10904:                 }
                   10905:             }
                   10906:         }
1.984     raeburn  10907:     }
                   10908:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10909:         if (exists($currfile{$file})) {
1.987     raeburn  10910:             unless ($mapping{$file} eq $file) {
                   10911:                 $pathchanges{$file} = 1;
                   10912:             }
                   10913:             $existing{$file} = 1;
                   10914:             $numexisting ++;
                   10915:         } else {
1.984     raeburn  10916:             $newfiles{$file} = 1;
                   10917:         }
                   10918:     }
1.1071    raeburn  10919:     foreach my $file (keys(%currfile)) {
                   10920:         unless (($file eq $filename) ||
                   10921:                 ($file eq $filename.'.bak') ||
                   10922:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10923:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10924:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10925:                     next if (($rem ne '') &&
                   10926:                              (($env{"httpref.$rem".$file} ne '') ||
                   10927:                               (ref($navmap) &&
                   10928:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10929:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10930:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10931:                 }
1.1075.2.11  raeburn  10932:             }
1.1071    raeburn  10933:             $unused{$file} = 1;
                   10934:         }
                   10935:     }
1.1075.2.11  raeburn  10936:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10937:         ($args->{'context'} eq 'paste')) {
                   10938:         $counter = scalar(keys(%existing));
                   10939:         $numpathchg = scalar(keys(%pathchanges));
                   10940:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10941:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10942:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10943:         $counter = scalar(keys(%existing));
                   10944:         $numpathchg = scalar(keys(%pathchanges));
                   10945:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10946:     }
1.984     raeburn  10947:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10948:         if ($actionurl eq '/adm/dependencies') {
                   10949:             next if ($embed_file =~ m{^\w+://});
                   10950:         }
1.660     raeburn  10951:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10952:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10953:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10954:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10955:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10956:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10957:         }
1.1075.2.35  raeburn  10958:         $upload_output .= '</td>';
1.1071    raeburn  10959:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10960:             $upload_output.='<td align="right">'.
                   10961:                             '<span class="LC_info LC_fontsize_medium">'.
                   10962:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10963:             $numremref++;
1.660     raeburn  10964:         } elsif ($args->{'error_on_invalid_names'}
                   10965:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10966:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10967:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10968:             $numinvalid++;
1.660     raeburn  10969:         } else {
1.1075.2.35  raeburn  10970:             $upload_output .= '<td>'.
                   10971:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10972:                                                      $embed_file,\%mapping,
1.1071    raeburn  10973:                                                      $allfiles,$codebase,'upload');
                   10974:             $counter ++;
                   10975:             $numnew ++;
1.987     raeburn  10976:         }
                   10977:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10978:     }
                   10979:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10980:         if ($actionurl eq '/adm/dependencies') {
                   10981:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10982:             $modify_output .= &start_data_table_row().
                   10983:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10984:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10985:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10986:                               '<td>'.$size.'</td>'.
                   10987:                               '<td>'.$mtime.'</td>'.
                   10988:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10989:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10990:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10991:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10992:                               &embedded_file_element('upload_embedded',$counter,
                   10993:                                                      $embed_file,\%mapping,
                   10994:                                                      $allfiles,$codebase,'modify').
                   10995:                               '</div></td>'.
                   10996:                               &end_data_table_row()."\n";
                   10997:             $counter ++;
                   10998:         } else {
                   10999:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  11000:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   11001:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   11002:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  11003:                               &Apache::loncommon::end_data_table_row()."\n";
                   11004:         }
                   11005:     }
                   11006:     my $delidx = $counter;
                   11007:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   11008:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   11009:         $delete_output .= &start_data_table_row().
                   11010:                           '<td><img src="'.&icon($oldfile).'" />'.
                   11011:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   11012:                           '<td>'.$size.'</td>'.
                   11013:                           '<td>'.$mtime.'</td>'.
                   11014:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   11015:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   11016:                           &embedded_file_element('upload_embedded',$delidx,
                   11017:                                                  $oldfile,\%mapping,$allfiles,
                   11018:                                                  $codebase,'delete').'</td>'.
                   11019:                           &end_data_table_row()."\n"; 
                   11020:         $numunused ++;
                   11021:         $delidx ++;
1.987     raeburn  11022:     }
                   11023:     if ($upload_output) {
                   11024:         $upload_output = &start_data_table().
                   11025:                          $upload_output.
                   11026:                          &end_data_table()."\n";
                   11027:     }
1.1071    raeburn  11028:     if ($modify_output) {
                   11029:         $modify_output = &start_data_table().
                   11030:                          &start_data_table_header_row().
                   11031:                          '<th>'.&mt('File').'</th>'.
                   11032:                          '<th>'.&mt('Size (KB)').'</th>'.
                   11033:                          '<th>'.&mt('Modified').'</th>'.
                   11034:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   11035:                          &end_data_table_header_row().
                   11036:                          $modify_output.
                   11037:                          &end_data_table()."\n";
                   11038:     }
                   11039:     if ($delete_output) {
                   11040:         $delete_output = &start_data_table().
                   11041:                          &start_data_table_header_row().
                   11042:                          '<th>'.&mt('File').'</th>'.
                   11043:                          '<th>'.&mt('Size (KB)').'</th>'.
                   11044:                          '<th>'.&mt('Modified').'</th>'.
                   11045:                          '<th>'.&mt('Delete?').'</th>'.
                   11046:                          &end_data_table_header_row().
                   11047:                          $delete_output.
                   11048:                          &end_data_table()."\n";
                   11049:     }
1.987     raeburn  11050:     my $applies = 0;
                   11051:     if ($numremref) {
                   11052:         $applies ++;
                   11053:     }
                   11054:     if ($numinvalid) {
                   11055:         $applies ++;
                   11056:     }
                   11057:     if ($numexisting) {
                   11058:         $applies ++;
                   11059:     }
1.1071    raeburn  11060:     if ($counter || $numunused) {
1.987     raeburn  11061:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   11062:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  11063:                   $state.'<h3>'.$heading.'</h3>'; 
                   11064:         if ($actionurl eq '/adm/dependencies') {
                   11065:             if ($numnew) {
                   11066:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   11067:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   11068:                            $upload_output.'<br />'."\n";
                   11069:             }
                   11070:             if ($numexisting) {
                   11071:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   11072:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   11073:                            $modify_output.'<br />'."\n";
                   11074:                            $buttontext = &mt('Save changes');
                   11075:             }
                   11076:             if ($numunused) {
                   11077:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   11078:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   11079:                            $delete_output.'<br />'."\n";
                   11080:                            $buttontext = &mt('Save changes');
                   11081:             }
                   11082:         } else {
                   11083:             $output .= $upload_output.'<br />'."\n";
                   11084:         }
                   11085:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   11086:                    $counter.'" />'."\n";
                   11087:         if ($actionurl eq '/adm/dependencies') { 
                   11088:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   11089:                        $numnew.'" />'."\n";
                   11090:         } elsif ($actionurl eq '') {
1.987     raeburn  11091:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   11092:         }
                   11093:     } elsif ($applies) {
                   11094:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   11095:         if ($applies > 1) {
                   11096:             $output .=  
1.1075.2.35  raeburn  11097:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  11098:             if ($numremref) {
                   11099:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   11100:             }
                   11101:             if ($numinvalid) {
                   11102:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   11103:             }
                   11104:             if ($numexisting) {
                   11105:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   11106:             }
                   11107:             $output .= '</ul><br />';
                   11108:         } elsif ($numremref) {
                   11109:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   11110:         } elsif ($numinvalid) {
                   11111:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   11112:         } elsif ($numexisting) {
                   11113:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   11114:         }
                   11115:         $output .= $upload_output.'<br />';
                   11116:     }
                   11117:     my ($pathchange_output,$chgcount);
1.1071    raeburn  11118:     $chgcount = $counter;
1.987     raeburn  11119:     if (keys(%pathchanges) > 0) {
                   11120:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  11121:             if ($counter) {
1.987     raeburn  11122:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   11123:                                                   $embed_file,\%mapping,
1.1071    raeburn  11124:                                                   $allfiles,$codebase,'change');
1.987     raeburn  11125:             } else {
                   11126:                 $pathchange_output .= 
                   11127:                     &start_data_table_row().
                   11128:                     '<td><input type ="checkbox" name="namechange" value="'.
                   11129:                     $chgcount.'" checked="checked" /></td>'.
                   11130:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   11131:                     '<td>'.$embed_file.
                   11132:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  11133:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  11134:                     '</td>'.&end_data_table_row();
1.660     raeburn  11135:             }
1.987     raeburn  11136:             $numpathchg ++;
                   11137:             $chgcount ++;
1.660     raeburn  11138:         }
                   11139:     }
1.1075.2.35  raeburn  11140:     if (($counter) || ($numunused)) {
1.987     raeburn  11141:         if ($numpathchg) {
                   11142:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   11143:                        $numpathchg.'" />'."\n";
                   11144:         }
                   11145:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   11146:             ($actionurl eq '/adm/imsimport')) {
                   11147:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   11148:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   11149:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  11150:         } elsif ($actionurl eq '/adm/dependencies') {
                   11151:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  11152:         }
1.1075.2.35  raeburn  11153:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  11154:     } elsif ($numpathchg) {
                   11155:         my %pathchange = ();
                   11156:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   11157:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11158:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  11159:         }
1.987     raeburn  11160:     }
1.1071    raeburn  11161:     return ($output,$counter,$numpathchg);
1.987     raeburn  11162: }
                   11163: 
1.1075.2.47  raeburn  11164: =pod
                   11165: 
                   11166: =item * clean_path($name)
                   11167: 
                   11168: Performs clean-up of directories, subdirectories and filename in an
                   11169: embedded object, referenced in an HTML file which is being uploaded
                   11170: to a course or portfolio, where
                   11171: "Upload embedded images/multimedia files if HTML file" checkbox was
                   11172: checked.
                   11173: 
                   11174: Clean-up is similar to replacements in lonnet::clean_filename()
                   11175: except each / between sub-directory and next level is preserved.
                   11176: 
                   11177: =cut
                   11178: 
                   11179: sub clean_path {
                   11180:     my ($embed_file) = @_;
                   11181:     $embed_file =~s{^/+}{};
                   11182:     my @contents;
                   11183:     if ($embed_file =~ m{/}) {
                   11184:         @contents = split(/\//,$embed_file);
                   11185:     } else {
                   11186:         @contents = ($embed_file);
                   11187:     }
                   11188:     my $lastidx = scalar(@contents)-1;
                   11189:     for (my $i=0; $i<=$lastidx; $i++) {
                   11190:         $contents[$i]=~s{\\}{/}g;
                   11191:         $contents[$i]=~s/\s+/\_/g;
                   11192:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   11193:         if ($i == $lastidx) {
                   11194:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   11195:         }
                   11196:     }
                   11197:     if ($lastidx > 0) {
                   11198:         return join('/',@contents);
                   11199:     } else {
                   11200:         return $contents[0];
                   11201:     }
                   11202: }
                   11203: 
1.987     raeburn  11204: sub embedded_file_element {
1.1071    raeburn  11205:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  11206:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   11207:                    (ref($codebase) eq 'HASH'));
                   11208:     my $output;
1.1071    raeburn  11209:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  11210:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   11211:     }
                   11212:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   11213:                &escape($embed_file).'" />';
                   11214:     unless (($context eq 'upload_embedded') && 
                   11215:             ($mapping->{$embed_file} eq $embed_file)) {
                   11216:         $output .='
                   11217:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   11218:     }
                   11219:     my $attrib;
                   11220:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   11221:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   11222:     }
                   11223:     $output .=
                   11224:         "\n\t\t".
                   11225:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   11226:         $attrib.'" />';
                   11227:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   11228:         $output .=
                   11229:             "\n\t\t".
                   11230:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   11231:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  11232:     }
1.987     raeburn  11233:     return $output;
1.660     raeburn  11234: }
                   11235: 
1.1071    raeburn  11236: sub get_dependency_details {
                   11237:     my ($currfile,$currsubfile,$embed_file) = @_;
                   11238:     my ($size,$mtime,$showsize,$showmtime);
                   11239:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   11240:         if ($embed_file =~ m{/}) {
                   11241:             my ($path,$fname) = split(/\//,$embed_file);
                   11242:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   11243:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   11244:             }
                   11245:         } else {
                   11246:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   11247:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   11248:             }
                   11249:         }
                   11250:         $showsize = $size/1024.0;
                   11251:         $showsize = sprintf("%.1f",$showsize);
                   11252:         if ($mtime > 0) {
                   11253:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   11254:         }
                   11255:     }
                   11256:     return ($showsize,$showmtime);
                   11257: }
                   11258: 
                   11259: sub ask_embedded_js {
                   11260:     return <<"END";
                   11261: <script type="text/javascript"">
                   11262: // <![CDATA[
                   11263: function toggleBrowse(counter) {
                   11264:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   11265:     var fileid = document.getElementById('embedded_item_'+counter);
                   11266:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   11267:     if (chkboxid.checked == true) {
                   11268:         uploaddivid.style.display='block';
                   11269:     } else {
                   11270:         uploaddivid.style.display='none';
                   11271:         fileid.value = '';
                   11272:     }
                   11273: }
                   11274: // ]]>
                   11275: </script>
                   11276: 
                   11277: END
                   11278: }
                   11279: 
1.661     raeburn  11280: sub upload_embedded {
                   11281:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  11282:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   11283:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  11284:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   11285:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   11286:         my $orig_uploaded_filename =
                   11287:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  11288:         foreach my $type ('orig','ref','attrib','codebase') {
                   11289:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   11290:                 $env{'form.embedded_'.$type.'_'.$i} =
                   11291:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   11292:             }
                   11293:         }
1.661     raeburn  11294:         my ($path,$fname) =
                   11295:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   11296:         # no path, whole string is fname
                   11297:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   11298:         $fname = &Apache::lonnet::clean_filename($fname);
                   11299:         # See if there is anything left
                   11300:         next if ($fname eq '');
                   11301: 
                   11302:         # Check if file already exists as a file or directory.
                   11303:         my ($state,$msg);
                   11304:         if ($context eq 'portfolio') {
                   11305:             my $port_path = $dirpath;
                   11306:             if ($group ne '') {
                   11307:                 $port_path = "groups/$group/$port_path";
                   11308:             }
1.987     raeburn  11309:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   11310:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  11311:                                               $dir_root,$port_path,$disk_quota,
                   11312:                                               $current_disk_usage,$uname,$udom);
                   11313:             if ($state eq 'will_exceed_quota'
1.984     raeburn  11314:                 || $state eq 'file_locked') {
1.661     raeburn  11315:                 $output .= $msg;
                   11316:                 next;
                   11317:             }
                   11318:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   11319:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   11320:             if ($state eq 'exists') {
                   11321:                 $output .= $msg;
                   11322:                 next;
                   11323:             }
                   11324:         }
                   11325:         # Check if extension is valid
                   11326:         if (($fname =~ /\.(\w+)$/) &&
                   11327:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  11328:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   11329:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  11330:             next;
                   11331:         } elsif (($fname =~ /\.(\w+)$/) &&
                   11332:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  11333:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  11334:             next;
                   11335:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  11336:             $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  11337:             next;
                   11338:         }
                   11339:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  11340:         my $subdir = $path;
                   11341:         $subdir =~ s{/+$}{};
1.661     raeburn  11342:         if ($context eq 'portfolio') {
1.984     raeburn  11343:             my $result;
                   11344:             if ($state eq 'existingfile') {
                   11345:                 $result=
                   11346:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  11347:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  11348:             } else {
1.984     raeburn  11349:                 $result=
                   11350:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  11351:                                                     $dirpath.
1.1075.2.35  raeburn  11352:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  11353:                 if ($result !~ m|^/uploaded/|) {
                   11354:                     $output .= '<span class="LC_error">'
                   11355:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11356:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11357:                                .'</span><br />';
                   11358:                     next;
                   11359:                 } else {
1.987     raeburn  11360:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11361:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  11362:                 }
1.661     raeburn  11363:             }
1.1075.2.35  raeburn  11364:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   11365:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   11366:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  11367:             my $result =
1.1075.2.35  raeburn  11368:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  11369:             if ($result !~ m|^/uploaded/|) {
                   11370:                 $output .= '<span class="LC_error">'
                   11371:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11372:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11373:                            .'</span><br />';
                   11374:                     next;
                   11375:             } else {
                   11376:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11377:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  11378:                 if ($context eq 'syllabus') {
                   11379:                     &Apache::lonnet::make_public_indefinitely($result);
                   11380:                 }
1.987     raeburn  11381:             }
1.661     raeburn  11382:         } else {
                   11383: # Save the file
                   11384:             my $target = $env{'form.embedded_item_'.$i};
                   11385:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   11386:             my $dest = $fullpath.$fname;
                   11387:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  11388:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  11389:             my $count;
                   11390:             my $filepath = $dir_root;
1.1027    raeburn  11391:             foreach my $subdir (@parts) {
                   11392:                 $filepath .= "/$subdir";
                   11393:                 if (!-e $filepath) {
1.661     raeburn  11394:                     mkdir($filepath,0770);
                   11395:                 }
                   11396:             }
                   11397:             my $fh;
                   11398:             if (!open($fh,'>'.$dest)) {
                   11399:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   11400:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  11401:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   11402:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11403:                            '</span><br />';
                   11404:             } else {
                   11405:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   11406:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   11407:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  11408:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   11409:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11410:                               '</span><br />';
                   11411:                 } else {
1.987     raeburn  11412:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11413:                                $url.'</span>').'<br />';
                   11414:                     unless ($context eq 'testbank') {
                   11415:                         $footer .= &mt('View embedded file: [_1]',
                   11416:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   11417:                     }
                   11418:                 }
                   11419:                 close($fh);
                   11420:             }
                   11421:         }
                   11422:         if ($env{'form.embedded_ref_'.$i}) {
                   11423:             $pathchange{$i} = 1;
                   11424:         }
                   11425:     }
                   11426:     if ($output) {
                   11427:         $output = '<p>'.$output.'</p>';
                   11428:     }
                   11429:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   11430:     $returnflag = 'ok';
1.1071    raeburn  11431:     my $numpathchgs = scalar(keys(%pathchange));
                   11432:     if ($numpathchgs > 0) {
1.987     raeburn  11433:         if ($context eq 'portfolio') {
                   11434:             $output .= '<p>'.&mt('or').'</p>';
                   11435:         } elsif ($context eq 'testbank') {
1.1071    raeburn  11436:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   11437:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  11438:             $returnflag = 'modify_orightml';
                   11439:         }
                   11440:     }
1.1071    raeburn  11441:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  11442: }
                   11443: 
                   11444: sub modify_html_form {
                   11445:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   11446:     my $end = 0;
                   11447:     my $modifyform;
                   11448:     if ($context eq 'upload_embedded') {
                   11449:         return unless (ref($pathchange) eq 'HASH');
                   11450:         if ($env{'form.number_embedded_items'}) {
                   11451:             $end += $env{'form.number_embedded_items'};
                   11452:         }
                   11453:         if ($env{'form.number_pathchange_items'}) {
                   11454:             $end += $env{'form.number_pathchange_items'};
                   11455:         }
                   11456:         if ($end) {
                   11457:             for (my $i=0; $i<$end; $i++) {
                   11458:                 if ($i < $env{'form.number_embedded_items'}) {
                   11459:                     next unless($pathchange->{$i});
                   11460:                 }
                   11461:                 $modifyform .=
                   11462:                     &start_data_table_row().
                   11463:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   11464:                     'checked="checked" /></td>'.
                   11465:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   11466:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   11467:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   11468:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   11469:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   11470:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   11471:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   11472:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   11473:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   11474:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   11475:                     &end_data_table_row();
1.1071    raeburn  11476:             }
1.987     raeburn  11477:         }
                   11478:     } else {
                   11479:         $modifyform = $pathchgtable;
                   11480:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   11481:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   11482:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11483:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   11484:         }
                   11485:     }
                   11486:     if ($modifyform) {
1.1071    raeburn  11487:         if ($actionurl eq '/adm/dependencies') {
                   11488:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   11489:         }
1.987     raeburn  11490:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   11491:                '<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".
                   11492:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   11493:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   11494:                '</ol></p>'."\n".'<p>'.
                   11495:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   11496:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   11497:                &start_data_table()."\n".
                   11498:                &start_data_table_header_row().
                   11499:                '<th>'.&mt('Change?').'</th>'.
                   11500:                '<th>'.&mt('Current reference').'</th>'.
                   11501:                '<th>'.&mt('Required reference').'</th>'.
                   11502:                &end_data_table_header_row()."\n".
                   11503:                $modifyform.
                   11504:                &end_data_table().'<br />'."\n".$hiddenstate.
                   11505:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   11506:                '</form>'."\n";
                   11507:     }
                   11508:     return;
                   11509: }
                   11510: 
                   11511: sub modify_html_refs {
1.1075.2.35  raeburn  11512:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  11513:     my $container;
                   11514:     if ($context eq 'portfolio') {
                   11515:         $container = $env{'form.container'};
                   11516:     } elsif ($context eq 'coursedoc') {
                   11517:         $container = $env{'form.primaryurl'};
1.1071    raeburn  11518:     } elsif ($context eq 'manage_dependencies') {
                   11519:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   11520:         $container = "/$container";
1.1075.2.35  raeburn  11521:     } elsif ($context eq 'syllabus') {
                   11522:         $container = $url;
1.987     raeburn  11523:     } else {
1.1027    raeburn  11524:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  11525:     }
                   11526:     my (%allfiles,%codebase,$output,$content);
                   11527:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  11528:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  11529:         if (wantarray) {
                   11530:             return ('',0,0); 
                   11531:         } else {
                   11532:             return;
                   11533:         }
                   11534:     }
                   11535:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  11536:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  11537:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   11538:             if (wantarray) {
                   11539:                 return ('',0,0);
                   11540:             } else {
                   11541:                 return;
                   11542:             }
                   11543:         } 
1.987     raeburn  11544:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  11545:         if ($content eq '-1') {
                   11546:             if (wantarray) {
                   11547:                 return ('',0,0);
                   11548:             } else {
                   11549:                 return;
                   11550:             }
                   11551:         }
1.987     raeburn  11552:     } else {
1.1071    raeburn  11553:         unless ($container =~ /^\Q$dir_root\E/) {
                   11554:             if (wantarray) {
                   11555:                 return ('',0,0);
                   11556:             } else {
                   11557:                 return;
                   11558:             }
                   11559:         } 
1.1075.2.128  raeburn  11560:         if (open(my $fh,'<',$container)) {
1.987     raeburn  11561:             $content = join('', <$fh>);
                   11562:             close($fh);
                   11563:         } else {
1.1071    raeburn  11564:             if (wantarray) {
                   11565:                 return ('',0,0);
                   11566:             } else {
                   11567:                 return;
                   11568:             }
1.987     raeburn  11569:         }
                   11570:     }
                   11571:     my ($count,$codebasecount) = (0,0);
                   11572:     my $mm = new File::MMagic;
                   11573:     my $mime_type = $mm->checktype_contents($content);
                   11574:     if ($mime_type eq 'text/html') {
                   11575:         my $parse_result = 
                   11576:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   11577:                                                     \%codebase,\$content);
                   11578:         if ($parse_result eq 'ok') {
                   11579:             foreach my $i (@changes) {
                   11580:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   11581:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   11582:                 if ($allfiles{$ref}) {
                   11583:                     my $newname =  $orig;
                   11584:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  11585:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  11586:                     if ($attrib_regexp =~ /:/) {
                   11587:                         $attrib_regexp =~ s/\:/|/g;
                   11588:                     }
                   11589:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11590:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11591:                         $count += $numchg;
1.1075.2.35  raeburn  11592:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  11593:                         delete($allfiles{$ref});
1.987     raeburn  11594:                     }
                   11595:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  11596:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  11597:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   11598:                         $codebasecount ++;
                   11599:                     }
                   11600:                 }
                   11601:             }
1.1075.2.35  raeburn  11602:             my $skiprewrites;
1.987     raeburn  11603:             if ($count || $codebasecount) {
                   11604:                 my $saveresult;
1.1071    raeburn  11605:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  11606:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  11607:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11608:                     if ($url eq $container) {
                   11609:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   11610:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11611:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  11612:                                             $fname.'</span>').'</p>';
1.987     raeburn  11613:                     } else {
                   11614:                          $output = '<p class="LC_error">'.
                   11615:                                    &mt('Error: update failed for: [_1].',
                   11616:                                    '<span class="LC_filename">'.
                   11617:                                    $container.'</span>').'</p>';
                   11618:                     }
1.1075.2.35  raeburn  11619:                     if ($context eq 'syllabus') {
                   11620:                         unless ($saveresult eq 'ok') {
                   11621:                             $skiprewrites = 1;
                   11622:                         }
                   11623:                     }
1.987     raeburn  11624:                 } else {
1.1075.2.128  raeburn  11625:                     if (open(my $fh,'>',$container)) {
1.987     raeburn  11626:                         print $fh $content;
                   11627:                         close($fh);
                   11628:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11629:                                   $count,'<span class="LC_filename">'.
                   11630:                                   $container.'</span>').'</p>';
1.661     raeburn  11631:                     } else {
1.987     raeburn  11632:                          $output = '<p class="LC_error">'.
                   11633:                                    &mt('Error: could not update [_1].',
                   11634:                                    '<span class="LC_filename">'.
                   11635:                                    $container.'</span>').'</p>';
1.661     raeburn  11636:                     }
                   11637:                 }
                   11638:             }
1.1075.2.35  raeburn  11639:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   11640:                 my ($actionurl,$state);
                   11641:                 $actionurl = "/public/$udom/$uname/syllabus";
                   11642:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   11643:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   11644:                                               \%codebase,
                   11645:                                               {'context' => 'rewrites',
                   11646:                                                'ignore_remote_references' => 1,});
                   11647:                 if (ref($mapping) eq 'HASH') {
                   11648:                     my $rewrites = 0;
                   11649:                     foreach my $key (keys(%{$mapping})) {
                   11650:                         next if ($key =~ m{^https?://});
                   11651:                         my $ref = $mapping->{$key};
                   11652:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   11653:                         my $attrib;
                   11654:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   11655:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   11656:                         }
                   11657:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11658:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11659:                             $rewrites += $numchg;
                   11660:                         }
                   11661:                     }
                   11662:                     if ($rewrites) {
                   11663:                         my $saveresult;
                   11664:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11665:                         if ($url eq $container) {
                   11666:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   11667:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   11668:                                             $count,'<span class="LC_filename">'.
                   11669:                                             $fname.'</span>').'</p>';
                   11670:                         } else {
                   11671:                             $output .= '<p class="LC_error">'.
                   11672:                                        &mt('Error: could not update links in [_1].',
                   11673:                                        '<span class="LC_filename">'.
                   11674:                                        $container.'</span>').'</p>';
                   11675: 
                   11676:                         }
                   11677:                     }
                   11678:                 }
                   11679:             }
1.987     raeburn  11680:         } else {
                   11681:             &logthis('Failed to parse '.$container.
                   11682:                      ' to modify references: '.$parse_result);
1.661     raeburn  11683:         }
                   11684:     }
1.1071    raeburn  11685:     if (wantarray) {
                   11686:         return ($output,$count,$codebasecount);
                   11687:     } else {
                   11688:         return $output;
                   11689:     }
1.661     raeburn  11690: }
                   11691: 
                   11692: sub check_for_existing {
                   11693:     my ($path,$fname,$element) = @_;
                   11694:     my ($state,$msg);
                   11695:     if (-d $path.'/'.$fname) {
                   11696:         $state = 'exists';
                   11697:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11698:     } elsif (-e $path.'/'.$fname) {
                   11699:         $state = 'exists';
                   11700:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11701:     }
                   11702:     if ($state eq 'exists') {
                   11703:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   11704:     }
                   11705:     return ($state,$msg);
                   11706: }
                   11707: 
                   11708: sub check_for_upload {
                   11709:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   11710:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  11711:     my $filesize = length($env{'form.'.$element});
                   11712:     if (!$filesize) {
                   11713:         my $msg = '<span class="LC_error">'.
                   11714:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   11715:                       '<span class="LC_filename">'.$fname.'</span>',
                   11716:                       $filesize).'<br />'.
1.1007    raeburn  11717:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  11718:                   '</span>';
                   11719:         return ('zero_bytes',$msg);
                   11720:     }
                   11721:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  11722:     my $getpropath = 1;
1.1021    raeburn  11723:     my ($dirlistref,$listerror) =
                   11724:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  11725:     my $found_file = 0;
                   11726:     my $locked_file = 0;
1.991     raeburn  11727:     my @lockers;
                   11728:     my $navmap;
                   11729:     if ($env{'request.course.id'}) {
                   11730:         $navmap = Apache::lonnavmaps::navmap->new();
                   11731:     }
1.1021    raeburn  11732:     if (ref($dirlistref) eq 'ARRAY') {
                   11733:         foreach my $line (@{$dirlistref}) {
                   11734:             my ($file_name,$rest)=split(/\&/,$line,2);
                   11735:             if ($file_name eq $fname){
                   11736:                 $file_name = $path.$file_name;
                   11737:                 if ($group ne '') {
                   11738:                     $file_name = $group.$file_name;
                   11739:                 }
                   11740:                 $found_file = 1;
                   11741:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   11742:                     foreach my $lock (@lockers) {
                   11743:                         if (ref($lock) eq 'ARRAY') {
                   11744:                             my ($symb,$crsid) = @{$lock};
                   11745:                             if ($crsid eq $env{'request.course.id'}) {
                   11746:                                 if (ref($navmap)) {
                   11747:                                     my $res = $navmap->getBySymb($symb);
                   11748:                                     foreach my $part (@{$res->parts()}) { 
                   11749:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   11750:                                         unless (($slot_status == $res->RESERVED) ||
                   11751:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   11752:                                             $locked_file = 1;
                   11753:                                         }
1.991     raeburn  11754:                                     }
1.1021    raeburn  11755:                                 } else {
                   11756:                                     $locked_file = 1;
1.991     raeburn  11757:                                 }
                   11758:                             } else {
                   11759:                                 $locked_file = 1;
                   11760:                             }
                   11761:                         }
1.1021    raeburn  11762:                    }
                   11763:                 } else {
                   11764:                     my @info = split(/\&/,$rest);
                   11765:                     my $currsize = $info[6]/1000;
                   11766:                     if ($currsize < $filesize) {
                   11767:                         my $extra = $filesize - $currsize;
                   11768:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  11769:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  11770:                                       &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.1075.2.69  raeburn  11771:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   11772:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   11773:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  11774:                             return ('will_exceed_quota',$msg);
                   11775:                         }
1.984     raeburn  11776:                     }
                   11777:                 }
1.661     raeburn  11778:             }
                   11779:         }
                   11780:     }
                   11781:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  11782:         my $msg = '<p class="LC_warning">'.
                   11783:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   11784:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  11785:         return ('will_exceed_quota',$msg);
                   11786:     } elsif ($found_file) {
                   11787:         if ($locked_file) {
1.1075.2.69  raeburn  11788:             my $msg = '<p class="LC_warning">';
1.661     raeburn  11789:             $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.1075.2.69  raeburn  11790:             $msg .= '</p>';
1.661     raeburn  11791:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   11792:             return ('file_locked',$msg);
                   11793:         } else {
1.1075.2.69  raeburn  11794:             my $msg = '<p class="LC_error">';
1.984     raeburn  11795:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1075.2.69  raeburn  11796:             $msg .= '</p>';
1.984     raeburn  11797:             return ('existingfile',$msg);
1.661     raeburn  11798:         }
                   11799:     }
                   11800: }
                   11801: 
1.987     raeburn  11802: sub check_for_traversal {
                   11803:     my ($path,$url,$toplevel) = @_;
                   11804:     my @parts=split(/\//,$path);
                   11805:     my $cleanpath;
                   11806:     my $fullpath = $url;
                   11807:     for (my $i=0;$i<@parts;$i++) {
                   11808:         next if ($parts[$i] eq '.');
                   11809:         if ($parts[$i] eq '..') {
                   11810:             $fullpath =~ s{([^/]+/)$}{};
                   11811:         } else {
                   11812:             $fullpath .= $parts[$i].'/';
                   11813:         }
                   11814:     }
                   11815:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   11816:         $cleanpath = $1;
                   11817:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11818:         my $curr_toprel = $1;
                   11819:         my @parts = split(/\//,$curr_toprel);
                   11820:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11821:         my @urlparts = split(/\//,$url_toprel);
                   11822:         my $doubledots;
                   11823:         my $startdiff = -1;
                   11824:         for (my $i=0; $i<@urlparts; $i++) {
                   11825:             if ($startdiff == -1) {
                   11826:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11827:                     $startdiff = $i;
                   11828:                     $doubledots .= '../';
                   11829:                 }
                   11830:             } else {
                   11831:                 $doubledots .= '../';
                   11832:             }
                   11833:         }
                   11834:         if ($startdiff > -1) {
                   11835:             $cleanpath = $doubledots;
                   11836:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11837:                 $cleanpath .= $parts[$i].'/';
                   11838:             }
                   11839:         }
                   11840:     }
                   11841:     $cleanpath =~ s{(/)$}{};
                   11842:     return $cleanpath;
                   11843: }
1.31      albertel 11844: 
1.1053    raeburn  11845: sub is_archive_file {
                   11846:     my ($mimetype) = @_;
                   11847:     if (($mimetype eq 'application/octet-stream') ||
                   11848:         ($mimetype eq 'application/x-stuffit') ||
                   11849:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11850:         return 1;
                   11851:     }
                   11852:     return;
                   11853: }
                   11854: 
                   11855: sub decompress_form {
1.1065    raeburn  11856:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11857:     my %lt = &Apache::lonlocal::texthash (
                   11858:         this => 'This file is an archive file.',
1.1067    raeburn  11859:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11860:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11861:         youm => 'You may wish to extract its contents.',
                   11862:         extr => 'Extract contents',
1.1067    raeburn  11863:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11864:         proa => 'Process automatically?',
1.1053    raeburn  11865:         yes  => 'Yes',
                   11866:         no   => 'No',
1.1067    raeburn  11867:         fold => 'Title for folder containing movie',
                   11868:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11869:     );
1.1065    raeburn  11870:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11871:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11872:     my $info = &list_archive_contents($fileloc,\@paths);
                   11873:     if (@paths) {
                   11874:         foreach my $path (@paths) {
                   11875:             $path =~ s{^/}{};
1.1067    raeburn  11876:             if ($path =~ m{^([^/]+)/$}) {
                   11877:                 $topdir = $1;
                   11878:             }
1.1065    raeburn  11879:             if ($path =~ m{^([^/]+)/}) {
                   11880:                 $toplevel{$1} = $path;
                   11881:             } else {
                   11882:                 $toplevel{$path} = $path;
                   11883:             }
                   11884:         }
                   11885:     }
1.1067    raeburn  11886:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  11887:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11888:                         "$topdir/media/",
                   11889:                         "$topdir/media/$topdir.mp4",
                   11890:                         "$topdir/media/FirstFrame.png",
                   11891:                         "$topdir/media/player.swf",
                   11892:                         "$topdir/media/swfobject.js",
                   11893:                         "$topdir/media/expressInstall.swf");
1.1075.2.81  raeburn  11894:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59  raeburn  11895:                          "$topdir/$topdir.mp4",
                   11896:                          "$topdir/$topdir\_config.xml",
                   11897:                          "$topdir/$topdir\_controller.swf",
                   11898:                          "$topdir/$topdir\_embed.css",
                   11899:                          "$topdir/$topdir\_First_Frame.png",
                   11900:                          "$topdir/$topdir\_player.html",
                   11901:                          "$topdir/$topdir\_Thumbnails.png",
                   11902:                          "$topdir/playerProductInstall.swf",
                   11903:                          "$topdir/scripts/",
                   11904:                          "$topdir/scripts/config_xml.js",
                   11905:                          "$topdir/scripts/handlebars.js",
                   11906:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11907:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11908:                          "$topdir/scripts/modernizr.js",
                   11909:                          "$topdir/scripts/player-min.js",
                   11910:                          "$topdir/scripts/swfobject.js",
                   11911:                          "$topdir/skins/",
                   11912:                          "$topdir/skins/configuration_express.xml",
                   11913:                          "$topdir/skins/express_show/",
                   11914:                          "$topdir/skins/express_show/player-min.css",
                   11915:                          "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81  raeburn  11916:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11917:                          "$topdir/$topdir.mp4",
                   11918:                          "$topdir/$topdir\_config.xml",
                   11919:                          "$topdir/$topdir\_controller.swf",
                   11920:                          "$topdir/$topdir\_embed.css",
                   11921:                          "$topdir/$topdir\_First_Frame.png",
                   11922:                          "$topdir/$topdir\_player.html",
                   11923:                          "$topdir/$topdir\_Thumbnails.png",
                   11924:                          "$topdir/playerProductInstall.swf",
                   11925:                          "$topdir/scripts/",
                   11926:                          "$topdir/scripts/config_xml.js",
                   11927:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11928:                          "$topdir/skins/",
                   11929:                          "$topdir/skins/configuration_express.xml",
                   11930:                          "$topdir/skins/express_show/",
                   11931:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11932:                          "$topdir/skins/express_show/spritesheet.png",
                   11933:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59  raeburn  11934:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11935:         if (@diffs == 0) {
1.1075.2.59  raeburn  11936:             $is_camtasia = 6;
                   11937:         } else {
1.1075.2.81  raeburn  11938:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59  raeburn  11939:             if (@diffs == 0) {
                   11940:                 $is_camtasia = 8;
1.1075.2.81  raeburn  11941:             } else {
                   11942:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11943:                 if (@diffs == 0) {
                   11944:                     $is_camtasia = 8;
                   11945:                 }
1.1075.2.59  raeburn  11946:             }
1.1067    raeburn  11947:         }
                   11948:     }
                   11949:     my $output;
                   11950:     if ($is_camtasia) {
                   11951:         $output = <<"ENDCAM";
                   11952: <script type="text/javascript" language="Javascript">
                   11953: // <![CDATA[
                   11954: 
                   11955: function camtasiaToggle() {
                   11956:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11957:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  11958:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11959:                 document.getElementById('camtasia_titles').style.display='block';
                   11960:             } else {
                   11961:                 document.getElementById('camtasia_titles').style.display='none';
                   11962:             }
                   11963:         }
                   11964:     }
                   11965:     return;
                   11966: }
                   11967: 
                   11968: // ]]>
                   11969: </script>
                   11970: <p>$lt{'camt'}</p>
                   11971: ENDCAM
1.1065    raeburn  11972:     } else {
1.1067    raeburn  11973:         $output = '<p>'.$lt{'this'};
                   11974:         if ($info eq '') {
                   11975:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11976:         } else {
                   11977:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11978:                        '<div><pre>'.$info.'</pre></div>';
                   11979:         }
1.1065    raeburn  11980:     }
1.1067    raeburn  11981:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11982:     my $duplicates;
                   11983:     my $num = 0;
                   11984:     if (ref($dirlist) eq 'ARRAY') {
                   11985:         foreach my $item (@{$dirlist}) {
                   11986:             if (ref($item) eq 'ARRAY') {
                   11987:                 if (exists($toplevel{$item->[0]})) {
                   11988:                     $duplicates .= 
                   11989:                         &start_data_table_row().
                   11990:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11991:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11992:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11993:                         'value="1" />'.&mt('Yes').'</label>'.
                   11994:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11995:                         '<td>'.$item->[0].'</td>';
                   11996:                     if ($item->[2]) {
                   11997:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11998:                     } else {
                   11999:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   12000:                     }
                   12001:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   12002:                                    '<td>'.
                   12003:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   12004:                                    '</td>'.
                   12005:                                    &end_data_table_row();
                   12006:                     $num ++;
                   12007:                 }
                   12008:             }
                   12009:         }
                   12010:     }
                   12011:     my $itemcount;
                   12012:     if (@paths > 0) {
                   12013:         $itemcount = scalar(@paths);
                   12014:     } else {
                   12015:         $itemcount = 1;
                   12016:     }
1.1067    raeburn  12017:     if ($is_camtasia) {
                   12018:         $output .= $lt{'auto'}.'<br />'.
                   12019:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  12020:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  12021:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   12022:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   12023:                    $lt{'no'}.'</label></span><br />'.
                   12024:                    '<div id="camtasia_titles" style="display:block">'.
                   12025:                    &Apache::lonhtmlcommon::start_pick_box().
                   12026:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   12027:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   12028:                    &Apache::lonhtmlcommon::row_closure().
                   12029:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   12030:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   12031:                    &Apache::lonhtmlcommon::row_closure(1).
                   12032:                    &Apache::lonhtmlcommon::end_pick_box().
                   12033:                    '</div>';
                   12034:     }
1.1065    raeburn  12035:     $output .= 
                   12036:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  12037:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   12038:         "\n";
1.1065    raeburn  12039:     if ($duplicates ne '') {
                   12040:         $output .= '<p><span class="LC_warning">'.
                   12041:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   12042:                    &start_data_table().
                   12043:                    &start_data_table_header_row().
                   12044:                    '<th>'.&mt('Overwrite?').'</th>'.
                   12045:                    '<th>'.&mt('Name').'</th>'.
                   12046:                    '<th>'.&mt('Type').'</th>'.
                   12047:                    '<th>'.&mt('Size').'</th>'.
                   12048:                    '<th>'.&mt('Last modified').'</th>'.
                   12049:                    &end_data_table_header_row().
                   12050:                    $duplicates.
                   12051:                    &end_data_table().
                   12052:                    '</p>';
                   12053:     }
1.1067    raeburn  12054:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  12055:     if (ref($hiddenelements) eq 'HASH') {
                   12056:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   12057:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   12058:         }
                   12059:     }
                   12060:     $output .= <<"END";
1.1067    raeburn  12061: <br />
1.1053    raeburn  12062: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   12063: </form>
                   12064: $noextract
                   12065: END
                   12066:     return $output;
                   12067: }
                   12068: 
1.1065    raeburn  12069: sub decompression_utility {
                   12070:     my ($program) = @_;
                   12071:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   12072:     my $location;
                   12073:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   12074:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   12075:                          '/usr/sbin/') {
                   12076:             if (-x $dir.$program) {
                   12077:                 $location = $dir.$program;
                   12078:                 last;
                   12079:             }
                   12080:         }
                   12081:     }
                   12082:     return $location;
                   12083: }
                   12084: 
                   12085: sub list_archive_contents {
                   12086:     my ($file,$pathsref) = @_;
                   12087:     my (@cmd,$output);
                   12088:     my $needsregexp;
                   12089:     if ($file =~ /\.zip$/) {
                   12090:         @cmd = (&decompression_utility('unzip'),"-l");
                   12091:         $needsregexp = 1;
                   12092:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   12093:              ($file =~ /\.tgz$/)) {
                   12094:         @cmd = (&decompression_utility('tar'),"-ztf");
                   12095:     } elsif ($file =~ /\.tar\.bz2$/) {
                   12096:         @cmd = (&decompression_utility('tar'),"-jtf");
                   12097:     } elsif ($file =~ m|\.tar$|) {
                   12098:         @cmd = (&decompression_utility('tar'),"-tf");
                   12099:     }
                   12100:     if (@cmd) {
                   12101:         undef($!);
                   12102:         undef($@);
                   12103:         if (open(my $fh,"-|", @cmd, $file)) {
                   12104:             while (my $line = <$fh>) {
                   12105:                 $output .= $line;
                   12106:                 chomp($line);
                   12107:                 my $item;
                   12108:                 if ($needsregexp) {
                   12109:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   12110:                 } else {
                   12111:                     $item = $line;
                   12112:                 }
                   12113:                 if ($item ne '') {
                   12114:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   12115:                         push(@{$pathsref},$item);
                   12116:                     } 
                   12117:                 }
                   12118:             }
                   12119:             close($fh);
                   12120:         }
                   12121:     }
                   12122:     return $output;
                   12123: }
                   12124: 
1.1053    raeburn  12125: sub decompress_uploaded_file {
                   12126:     my ($file,$dir) = @_;
                   12127:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   12128:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   12129:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   12130:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   12131:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   12132:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   12133:     my $decompressed = $env{'cgi.decompressed'};
                   12134:     &Apache::lonnet::delenv('cgi.file');
                   12135:     &Apache::lonnet::delenv('cgi.dir');
                   12136:     &Apache::lonnet::delenv('cgi.decompressed');
                   12137:     return ($decompressed,$result);
                   12138: }
                   12139: 
1.1055    raeburn  12140: sub process_decompression {
                   12141:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1075.2.128  raeburn  12142:     unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
                   12143:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12144:                &mt('Unexpected file path.').'</p>'."\n";
                   12145:     }
                   12146:     unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
                   12147:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12148:                &mt('Unexpected course context.').'</p>'."\n";
                   12149:     }
                   12150:     unless ($file eq &Apache::lonnet::clean_filename($file)) {
                   12151:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12152:                &mt('Filename contained unexpected characters.').'</p>'."\n";
                   12153:     }
1.1055    raeburn  12154:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  12155:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  12156:         $error = &mt('Filename not a supported archive file type.').
                   12157:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  12158:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   12159:     } else {
                   12160:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12161:         if ($docuhome eq 'no_host') {
                   12162:             $error = &mt('Could not determine home server for course.');
                   12163:         } else {
                   12164:             my @ids=&Apache::lonnet::current_machine_ids();
                   12165:             my $currdir = "$dir_root/$destination";
                   12166:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12167:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   12168:                        "$dir_root/$destination";
                   12169:             } else {
                   12170:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   12171:                        "$dir_root/$docudom/$docuname/$destination";
                   12172:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   12173:                     $error = &mt('Archive file not found.');
                   12174:                 }
                   12175:             }
1.1065    raeburn  12176:             my (@to_overwrite,@to_skip);
                   12177:             if ($env{'form.archive_overwrite_total'} > 0) {
                   12178:                 my $total = $env{'form.archive_overwrite_total'};
                   12179:                 for (my $i=0; $i<$total; $i++) {
                   12180:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   12181:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   12182:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   12183:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   12184:                     }
                   12185:                 }
                   12186:             }
                   12187:             my $numskip = scalar(@to_skip);
1.1075.2.128  raeburn  12188:             my $numoverwrite = scalar(@to_overwrite);
                   12189:             if (($numskip) && (!$numoverwrite)) {
1.1065    raeburn  12190:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   12191:             } elsif ($dir eq '') {
1.1055    raeburn  12192:                 $error = &mt('Directory containing archive file unavailable.');
                   12193:             } elsif (!$error) {
1.1065    raeburn  12194:                 my ($decompressed,$display);
1.1075.2.128  raeburn  12195:                 if (($numskip) || ($numoverwrite)) {
1.1065    raeburn  12196:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   12197:                     mkdir("$dir/$tempdir",0755);
1.1075.2.128  raeburn  12198:                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                   12199:                         ($decompressed,$display) =
                   12200:                             &decompress_uploaded_file($file,"$dir/$tempdir");
                   12201:                         foreach my $item (@to_skip) {
                   12202:                             if (($item ne '') && ($item !~ /\.\./)) {
                   12203:                                 if (-f "$dir/$tempdir/$item") {
                   12204:                                     unlink("$dir/$tempdir/$item");
                   12205:                                 } elsif (-d "$dir/$tempdir/$item") {
                   12206:                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
                   12207:                                 }
                   12208:                             }
                   12209:                         }
                   12210:                         foreach my $item (@to_overwrite) {
                   12211:                             if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
                   12212:                                 if (($item ne '') && ($item !~ /\.\./)) {
                   12213:                                     if (-f "$dir/$item") {
                   12214:                                         unlink("$dir/$item");
                   12215:                                     } elsif (-d "$dir/$item") {
                   12216:                                         &File::Path::remove_tree("$dir/$item",{ safe => 1 });
                   12217:                                     }
                   12218:                                     &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
                   12219:                                 }
1.1065    raeburn  12220:                             }
                   12221:                         }
1.1075.2.128  raeburn  12222:                         if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
                   12223:                             &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
                   12224:                         }
1.1065    raeburn  12225:                     }
                   12226:                 } else {
                   12227:                     ($decompressed,$display) = 
                   12228:                         &decompress_uploaded_file($file,$dir);
                   12229:                 }
1.1055    raeburn  12230:                 if ($decompressed eq 'ok') {
1.1065    raeburn  12231:                     $output = '<p class="LC_info">'.
                   12232:                               &mt('Files extracted successfully from archive.').
                   12233:                               '</p>'."\n";
1.1055    raeburn  12234:                     my ($warning,$result,@contents);
                   12235:                     my ($newdirlistref,$newlisterror) =
                   12236:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   12237:                                                  $docuname,1);
                   12238:                     my (%is_dir,%changes,@newitems);
                   12239:                     my $dirptr = 16384;
1.1065    raeburn  12240:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  12241:                         foreach my $dir_line (@{$newdirlistref}) {
                   12242:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1075.2.128  raeburn  12243:                             unless (($item =~ /^\.+$/) || ($item eq $file)) { 
1.1055    raeburn  12244:                                 push(@newitems,$item);
                   12245:                                 if ($dirptr&$testdir) {
                   12246:                                     $is_dir{$item} = 1;
                   12247:                                 }
                   12248:                                 $changes{$item} = 1;
                   12249:                             }
                   12250:                         }
                   12251:                     }
                   12252:                     if (keys(%changes) > 0) {
                   12253:                         foreach my $item (sort(@newitems)) {
                   12254:                             if ($changes{$item}) {
                   12255:                                 push(@contents,$item);
                   12256:                             }
                   12257:                         }
                   12258:                     }
                   12259:                     if (@contents > 0) {
1.1067    raeburn  12260:                         my $wantform;
                   12261:                         unless ($env{'form.autoextract_camtasia'}) {
                   12262:                             $wantform = 1;
                   12263:                         }
1.1056    raeburn  12264:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  12265:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   12266:                                                                 $currdir,\%is_dir,
                   12267:                                                                 \%children,\%parent,
1.1056    raeburn  12268:                                                                 \@contents,\%dirorder,
                   12269:                                                                 \%titles,$wantform);
1.1055    raeburn  12270:                         if ($datatable ne '') {
                   12271:                             $output .= &archive_options_form('decompressed',$datatable,
                   12272:                                                              $count,$hiddenelem);
1.1065    raeburn  12273:                             my $startcount = 6;
1.1055    raeburn  12274:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  12275:                                                            \%titles,\%children);
1.1055    raeburn  12276:                         }
1.1067    raeburn  12277:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  12278:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  12279:                             my %displayed;
                   12280:                             my $total = 1;
                   12281:                             $env{'form.archive_directory'} = [];
                   12282:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   12283:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   12284:                                 $path =~ s{/$}{};
                   12285:                                 my $item;
                   12286:                                 if ($path ne '') {
                   12287:                                     $item = "$path/$titles{$i}";
                   12288:                                 } else {
                   12289:                                     $item = $titles{$i};
                   12290:                                 }
                   12291:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   12292:                                 if ($item eq $contents[0]) {
                   12293:                                     push(@{$env{'form.archive_directory'}},$i);
                   12294:                                     $env{'form.archive_'.$i} = 'display';
                   12295:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   12296:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  12297:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   12298:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  12299:                                     $env{'form.archive_'.$i} = 'display';
                   12300:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   12301:                                     $displayed{'web'} = $i;
                   12302:                                 } else {
1.1075.2.59  raeburn  12303:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   12304:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   12305:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  12306:                                         push(@{$env{'form.archive_directory'}},$i);
                   12307:                                     }
                   12308:                                     $env{'form.archive_'.$i} = 'dependency';
                   12309:                                 }
                   12310:                                 $total ++;
                   12311:                             }
                   12312:                             for (my $i=1; $i<$total; $i++) {
                   12313:                                 next if ($i == $displayed{'web'});
                   12314:                                 next if ($i == $displayed{'folder'});
                   12315:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   12316:                             }
                   12317:                             $env{'form.phase'} = 'decompress_cleanup';
                   12318:                             $env{'form.archivedelete'} = 1;
                   12319:                             $env{'form.archive_count'} = $total-1;
                   12320:                             $output .=
                   12321:                                 &process_extracted_files('coursedocs',$docudom,
                   12322:                                                          $docuname,$destination,
                   12323:                                                          $dir_root,$hiddenelem);
                   12324:                         }
1.1055    raeburn  12325:                     } else {
                   12326:                         $warning = &mt('No new items extracted from archive file.');
                   12327:                     }
                   12328:                 } else {
                   12329:                     $output = $display;
                   12330:                     $error = &mt('An error occurred during extraction from the archive file.');
                   12331:                 }
                   12332:             }
                   12333:         }
                   12334:     }
                   12335:     if ($error) {
                   12336:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12337:                    $error.'</p>'."\n";
                   12338:     }
                   12339:     if ($warning) {
                   12340:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12341:     }
                   12342:     return $output;
                   12343: }
                   12344: 
                   12345: sub get_extracted {
1.1056    raeburn  12346:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   12347:         $titles,$wantform) = @_;
1.1055    raeburn  12348:     my $count = 0;
                   12349:     my $depth = 0;
                   12350:     my $datatable;
1.1056    raeburn  12351:     my @hierarchy;
1.1055    raeburn  12352:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  12353:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   12354:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  12355:     foreach my $item (@{$contents}) {
                   12356:         $count ++;
1.1056    raeburn  12357:         @{$dirorder->{$count}} = @hierarchy;
                   12358:         $titles->{$count} = $item;
1.1055    raeburn  12359:         &archive_hierarchy($depth,$count,$parent,$children);
                   12360:         if ($wantform) {
                   12361:             $datatable .= &archive_row($is_dir->{$item},$item,
                   12362:                                        $currdir,$depth,$count);
                   12363:         }
                   12364:         if ($is_dir->{$item}) {
                   12365:             $depth ++;
1.1056    raeburn  12366:             push(@hierarchy,$count);
                   12367:             $parent->{$depth} = $count;
1.1055    raeburn  12368:             $datatable .=
                   12369:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  12370:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   12371:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  12372:             $depth --;
1.1056    raeburn  12373:             pop(@hierarchy);
1.1055    raeburn  12374:         }
                   12375:     }
                   12376:     return ($count,$datatable);
                   12377: }
                   12378: 
                   12379: sub recurse_extracted_archive {
1.1056    raeburn  12380:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   12381:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  12382:     my $result='';
1.1056    raeburn  12383:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   12384:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   12385:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  12386:         return $result;
                   12387:     }
                   12388:     my $dirptr = 16384;
                   12389:     my ($newdirlistref,$newlisterror) =
                   12390:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   12391:     if (ref($newdirlistref) eq 'ARRAY') {
                   12392:         foreach my $dir_line (@{$newdirlistref}) {
                   12393:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   12394:             unless ($item =~ /^\.+$/) {
                   12395:                 $$count ++;
1.1056    raeburn  12396:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   12397:                 $titles->{$$count} = $item;
1.1055    raeburn  12398:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  12399: 
1.1055    raeburn  12400:                 my $is_dir;
                   12401:                 if ($dirptr&$testdir) {
                   12402:                     $is_dir = 1;
                   12403:                 }
                   12404:                 if ($wantform) {
                   12405:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   12406:                 }
                   12407:                 if ($is_dir) {
                   12408:                     $$depth ++;
1.1056    raeburn  12409:                     push(@{$hierarchy},$$count);
                   12410:                     $parent->{$$depth} = $$count;
1.1055    raeburn  12411:                     $result .=
                   12412:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   12413:                                                    $docuname,$depth,$count,
1.1056    raeburn  12414:                                                    $hierarchy,$dirorder,$children,
                   12415:                                                    $parent,$titles,$wantform);
1.1055    raeburn  12416:                     $$depth --;
1.1056    raeburn  12417:                     pop(@{$hierarchy});
1.1055    raeburn  12418:                 }
                   12419:             }
                   12420:         }
                   12421:     }
                   12422:     return $result;
                   12423: }
                   12424: 
                   12425: sub archive_hierarchy {
                   12426:     my ($depth,$count,$parent,$children) =@_;
                   12427:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   12428:         if (exists($parent->{$depth})) {
                   12429:              $children->{$parent->{$depth}} .= $count.':';
                   12430:         }
                   12431:     }
                   12432:     return;
                   12433: }
                   12434: 
                   12435: sub archive_row {
                   12436:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   12437:     my ($name) = ($item =~ m{([^/]+)$});
                   12438:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  12439:                                        'display'    => 'Add as file',
1.1055    raeburn  12440:                                        'dependency' => 'Include as dependency',
                   12441:                                        'discard'    => 'Discard',
                   12442:                                       );
                   12443:     if ($is_dir) {
1.1059    raeburn  12444:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  12445:     }
1.1056    raeburn  12446:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   12447:     my $offset = 0;
1.1055    raeburn  12448:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  12449:         $offset ++;
1.1065    raeburn  12450:         if ($action ne 'display') {
                   12451:             $offset ++;
                   12452:         }  
1.1055    raeburn  12453:         $output .= '<td><span class="LC_nobreak">'.
                   12454:                    '<label><input type="radio" name="archive_'.$count.
                   12455:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   12456:         my $text = $choices{$action};
                   12457:         if ($is_dir) {
                   12458:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   12459:             if ($action eq 'display') {
1.1059    raeburn  12460:                 $text = &mt('Add as folder');
1.1055    raeburn  12461:             }
1.1056    raeburn  12462:         } else {
                   12463:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   12464: 
                   12465:         }
                   12466:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   12467:         if ($action eq 'dependency') {
                   12468:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   12469:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   12470:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   12471:                        '<option value=""></option>'."\n".
                   12472:                        '</select>'."\n".
                   12473:                        '</div>';
1.1059    raeburn  12474:         } elsif ($action eq 'display') {
                   12475:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   12476:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   12477:                        '</div>';
1.1055    raeburn  12478:         }
1.1056    raeburn  12479:         $output .= '</td>';
1.1055    raeburn  12480:     }
                   12481:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   12482:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   12483:     for (my $i=0; $i<$depth; $i++) {
                   12484:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   12485:     }
                   12486:     if ($is_dir) {
                   12487:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   12488:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   12489:     } else {
                   12490:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   12491:     }
                   12492:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   12493:                &end_data_table_row();
                   12494:     return $output;
                   12495: }
                   12496: 
                   12497: sub archive_options_form {
1.1065    raeburn  12498:     my ($form,$display,$count,$hiddenelem) = @_;
                   12499:     my %lt = &Apache::lonlocal::texthash(
                   12500:                perm => 'Permanently remove archive file?',
                   12501:                hows => 'How should each extracted item be incorporated in the course?',
                   12502:                cont => 'Content actions for all',
                   12503:                addf => 'Add as folder/file',
                   12504:                incd => 'Include as dependency for a displayed file',
                   12505:                disc => 'Discard',
                   12506:                no   => 'No',
                   12507:                yes  => 'Yes',
                   12508:                save => 'Save',
                   12509:     );
                   12510:     my $output = <<"END";
                   12511: <form name="$form" method="post" action="">
                   12512: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   12513: <label>
                   12514:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   12515: </label>
                   12516: &nbsp;
                   12517: <label>
                   12518:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   12519: </span>
                   12520: </p>
                   12521: <input type="hidden" name="phase" value="decompress_cleanup" />
                   12522: <br />$lt{'hows'}
                   12523: <div class="LC_columnSection">
                   12524:   <fieldset>
                   12525:     <legend>$lt{'cont'}</legend>
                   12526:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   12527:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   12528:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   12529:   </fieldset>
                   12530: </div>
                   12531: END
                   12532:     return $output.
1.1055    raeburn  12533:            &start_data_table()."\n".
1.1065    raeburn  12534:            $display."\n".
1.1055    raeburn  12535:            &end_data_table()."\n".
                   12536:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   12537:            $hiddenelem.
1.1065    raeburn  12538:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  12539:            '</form>';
                   12540: }
                   12541: 
                   12542: sub archive_javascript {
1.1056    raeburn  12543:     my ($startcount,$numitems,$titles,$children) = @_;
                   12544:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  12545:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  12546:     my $scripttag = <<START;
                   12547: <script type="text/javascript">
                   12548: // <![CDATA[
                   12549: 
                   12550: function checkAll(form,prefix) {
                   12551:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   12552:     for (var i=0; i < form.elements.length; i++) {
                   12553:         var id = form.elements[i].id;
                   12554:         if ((id != '') && (id != undefined)) {
                   12555:             if (idstr.test(id)) {
                   12556:                 if (form.elements[i].type == 'radio') {
                   12557:                     form.elements[i].checked = true;
1.1056    raeburn  12558:                     var nostart = i-$startcount;
1.1059    raeburn  12559:                     var offset = nostart%7;
                   12560:                     var count = (nostart-offset)/7;    
1.1056    raeburn  12561:                     dependencyCheck(form,count,offset);
1.1055    raeburn  12562:                 }
                   12563:             }
                   12564:         }
                   12565:     }
                   12566: }
                   12567: 
                   12568: function propagateCheck(form,count) {
                   12569:     if (count > 0) {
1.1059    raeburn  12570:         var startelement = $startcount + ((count-1) * 7);
                   12571:         for (var j=1; j<6; j++) {
                   12572:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  12573:                 var item = startelement + j; 
                   12574:                 if (form.elements[item].type == 'radio') {
                   12575:                     if (form.elements[item].checked) {
                   12576:                         containerCheck(form,count,j);
                   12577:                         break;
                   12578:                     }
1.1055    raeburn  12579:                 }
                   12580:             }
                   12581:         }
                   12582:     }
                   12583: }
                   12584: 
                   12585: numitems = $numitems
1.1056    raeburn  12586: var titles = new Array(numitems);
                   12587: var parents = new Array(numitems);
1.1055    raeburn  12588: for (var i=0; i<numitems; i++) {
1.1056    raeburn  12589:     parents[i] = new Array;
1.1055    raeburn  12590: }
1.1059    raeburn  12591: var maintitle = '$maintitle';
1.1055    raeburn  12592: 
                   12593: START
                   12594: 
1.1056    raeburn  12595:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   12596:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  12597:         for (my $i=0; $i<@contents; $i ++) {
                   12598:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   12599:         }
                   12600:     }
                   12601: 
1.1056    raeburn  12602:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   12603:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   12604:     }
                   12605: 
1.1055    raeburn  12606:     $scripttag .= <<END;
                   12607: 
                   12608: function containerCheck(form,count,offset) {
                   12609:     if (count > 0) {
1.1056    raeburn  12610:         dependencyCheck(form,count,offset);
1.1059    raeburn  12611:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  12612:         form.elements[item].checked = true;
                   12613:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12614:             if (parents[count].length > 0) {
                   12615:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  12616:                     containerCheck(form,parents[count][j],offset);
                   12617:                 }
                   12618:             }
                   12619:         }
                   12620:     }
                   12621: }
                   12622: 
                   12623: function dependencyCheck(form,count,offset) {
                   12624:     if (count > 0) {
1.1059    raeburn  12625:         var chosen = (offset+$startcount)+7*(count-1);
                   12626:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  12627:         var currtype = form.elements[depitem].type;
                   12628:         if (form.elements[chosen].value == 'dependency') {
                   12629:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   12630:             form.elements[depitem].options.length = 0;
                   12631:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  12632:             for (var i=1; i<=numitems; i++) {
                   12633:                 if (i == count) {
                   12634:                     continue;
                   12635:                 }
1.1059    raeburn  12636:                 var startelement = $startcount + (i-1) * 7;
                   12637:                 for (var j=1; j<6; j++) {
                   12638:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  12639:                         var item = startelement + j;
                   12640:                         if (form.elements[item].type == 'radio') {
                   12641:                             if (form.elements[item].checked) {
                   12642:                                 if (form.elements[item].value == 'display') {
                   12643:                                     var n = form.elements[depitem].options.length;
                   12644:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   12645:                                 }
                   12646:                             }
                   12647:                         }
                   12648:                     }
                   12649:                 }
                   12650:             }
                   12651:         } else {
                   12652:             document.getElementById('arc_depon_'+count).style.display='none';
                   12653:             form.elements[depitem].options.length = 0;
                   12654:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   12655:         }
1.1059    raeburn  12656:         titleCheck(form,count,offset);
1.1056    raeburn  12657:     }
                   12658: }
                   12659: 
                   12660: function propagateSelect(form,count,offset) {
                   12661:     if (count > 0) {
1.1065    raeburn  12662:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  12663:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   12664:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12665:             if (parents[count].length > 0) {
                   12666:                 for (var j=0; j<parents[count].length; j++) {
                   12667:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  12668:                 }
                   12669:             }
                   12670:         }
                   12671:     }
                   12672: }
1.1056    raeburn  12673: 
                   12674: function containerSelect(form,count,offset,picked) {
                   12675:     if (count > 0) {
1.1065    raeburn  12676:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  12677:         if (form.elements[item].type == 'radio') {
                   12678:             if (form.elements[item].value == 'dependency') {
                   12679:                 if (form.elements[item+1].type == 'select-one') {
                   12680:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   12681:                         if (form.elements[item+1].options[i].value == picked) {
                   12682:                             form.elements[item+1].selectedIndex = i;
                   12683:                             break;
                   12684:                         }
                   12685:                     }
                   12686:                 }
                   12687:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12688:                     if (parents[count].length > 0) {
                   12689:                         for (var j=0; j<parents[count].length; j++) {
                   12690:                             containerSelect(form,parents[count][j],offset,picked);
                   12691:                         }
                   12692:                     }
                   12693:                 }
                   12694:             }
                   12695:         }
                   12696:     }
                   12697: }
                   12698: 
1.1059    raeburn  12699: function titleCheck(form,count,offset) {
                   12700:     if (count > 0) {
                   12701:         var chosen = (offset+$startcount)+7*(count-1);
                   12702:         var depitem = $startcount + ((count-1) * 7) + 2;
                   12703:         var currtype = form.elements[depitem].type;
                   12704:         if (form.elements[chosen].value == 'display') {
                   12705:             document.getElementById('arc_title_'+count).style.display='block';
                   12706:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   12707:                 document.getElementById('archive_title_'+count).value=maintitle;
                   12708:             }
                   12709:         } else {
                   12710:             document.getElementById('arc_title_'+count).style.display='none';
                   12711:             if (currtype == 'text') { 
                   12712:                 document.getElementById('archive_title_'+count).value='';
                   12713:             }
                   12714:         }
                   12715:     }
                   12716:     return;
                   12717: }
                   12718: 
1.1055    raeburn  12719: // ]]>
                   12720: </script>
                   12721: END
                   12722:     return $scripttag;
                   12723: }
                   12724: 
                   12725: sub process_extracted_files {
1.1067    raeburn  12726:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  12727:     my $numitems = $env{'form.archive_count'};
1.1075.2.128  raeburn  12728:     return if ((!$numitems) || ($numitems =~ /\D/));
1.1055    raeburn  12729:     my @ids=&Apache::lonnet::current_machine_ids();
                   12730:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  12731:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  12732:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12733:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12734:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   12735:         $pathtocheck = "$dir_root/$destination";
                   12736:         $dir = $dir_root;
                   12737:         $ishome = 1;
                   12738:     } else {
                   12739:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   12740:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1075.2.128  raeburn  12741:         $dir = "$dir_root/$docudom/$docuname";
1.1055    raeburn  12742:     }
                   12743:     my $currdir = "$dir_root/$destination";
                   12744:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   12745:     if ($env{'form.folderpath'}) {
                   12746:         my @items = split('&',$env{'form.folderpath'});
                   12747:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  12748:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   12749:             $containers{'0'}='page';
                   12750:         } else {
                   12751:             $containers{'0'}='sequence';
                   12752:         }
1.1055    raeburn  12753:     }
                   12754:     my @archdirs = &get_env_multiple('form.archive_directory');
                   12755:     if ($numitems) {
                   12756:         for (my $i=1; $i<=$numitems; $i++) {
                   12757:             my $path = $env{'form.archive_content_'.$i};
                   12758:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   12759:                 my $item = $1;
                   12760:                 $toplevelitems{$item} = $i;
                   12761:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   12762:                     $is_dir{$item} = 1;
                   12763:                 }
                   12764:             }
                   12765:         }
                   12766:     }
1.1067    raeburn  12767:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  12768:     if (keys(%toplevelitems) > 0) {
                   12769:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  12770:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   12771:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  12772:     }
1.1066    raeburn  12773:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  12774:     if ($numitems) {
                   12775:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  12776:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  12777:             my $path = $env{'form.archive_content_'.$i};
                   12778:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12779:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   12780:                     if ($prefix ne '' && $path ne '') {
                   12781:                         if (-e $prefix.$path) {
1.1066    raeburn  12782:                             if ((@archdirs > 0) && 
                   12783:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   12784:                                 $todeletedir{$prefix.$path} = 1;
                   12785:                             } else {
                   12786:                                 $todelete{$prefix.$path} = 1;
                   12787:                             }
1.1055    raeburn  12788:                         }
                   12789:                     }
                   12790:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  12791:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  12792:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  12793:                     $docstitle = $env{'form.archive_title_'.$i};
                   12794:                     if ($docstitle eq '') {
                   12795:                         $docstitle = $title;
                   12796:                     }
1.1055    raeburn  12797:                     $outer = 0;
1.1056    raeburn  12798:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12799:                         if (@{$dirorder{$i}} > 0) {
                   12800:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  12801:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   12802:                                     $outer = $item;
                   12803:                                     last;
                   12804:                                 }
                   12805:                             }
                   12806:                         }
                   12807:                     }
                   12808:                     my ($errtext,$fatal) = 
                   12809:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   12810:                                                '/'.$folders{$outer}.'.'.
                   12811:                                                $containers{$outer});
                   12812:                     next if ($fatal);
                   12813:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   12814:                         if ($context eq 'coursedocs') {
1.1056    raeburn  12815:                             $mapinner{$i} = time;
1.1055    raeburn  12816:                             $folders{$i} = 'default_'.$mapinner{$i};
                   12817:                             $containers{$i} = 'sequence';
                   12818:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12819:                                       $folders{$i}.'.'.$containers{$i};
                   12820:                             my $newidx = &LONCAPA::map::getresidx();
                   12821:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12822:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12823:                             push(@LONCAPA::map::order,$newidx);
                   12824:                             my ($outtext,$errtext) =
                   12825:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12826:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  12827:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  12828:                             $newseqid{$i} = $newidx;
1.1067    raeburn  12829:                             unless ($errtext) {
1.1075.2.128  raeburn  12830:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',
                   12831:                                                        &HTML::Entities::encode($docstitle,'<>&"'))..
                   12832:                                             '</li>'."\n";
1.1067    raeburn  12833:                             }
1.1055    raeburn  12834:                         }
                   12835:                     } else {
                   12836:                         if ($context eq 'coursedocs') {
                   12837:                             my $newidx=&LONCAPA::map::getresidx();
                   12838:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12839:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   12840:                                       $title;
1.1075.2.128  raeburn  12841:                             if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
                   12842:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   12843:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
1.1067    raeburn  12844:                                 }
1.1075.2.128  raeburn  12845:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12846:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12847:                                 }
                   12848:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12849:                                     if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
                   12850:                                         $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                   12851:                                         unless ($ishome) {
                   12852:                                             my $fetch = "$newdest{$i}/$title";
                   12853:                                             $fetch =~ s/^\Q$prefix$dir\E//;
                   12854:                                             $prompttofetch{$fetch} = 1;
                   12855:                                         }
                   12856:                                    }
                   12857:                                 }
                   12858:                                 $LONCAPA::map::resources[$newidx]=
                   12859:                                     $docstitle.':'.$url.':false:normal:res';
                   12860:                                 push(@LONCAPA::map::order, $newidx);
                   12861:                                 my ($outtext,$errtext)=
                   12862:                                     &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12863:                                                             $docuname.'/'.$folders{$outer}.
                   12864:                                                             '.'.$containers{$outer},1,1);
                   12865:                                 unless ($errtext) {
                   12866:                                     if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12867:                                         $result .= '<li>'.&mt('File: [_1] added to course',
                   12868:                                                               &HTML::Entities::encode($docstitle,'<>&"')).
                   12869:                                                    '</li>'."\n";
                   12870:                                     }
1.1067    raeburn  12871:                                 }
1.1075.2.128  raeburn  12872:                             } else {
                   12873:                                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   12874:                                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1067    raeburn  12875:                             }
1.1055    raeburn  12876:                         }
                   12877:                     }
1.1075.2.11  raeburn  12878:                 }
                   12879:             } else {
1.1075.2.128  raeburn  12880:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   12881:                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1075.2.11  raeburn  12882:             }
                   12883:         }
                   12884:         for (my $i=1; $i<=$numitems; $i++) {
                   12885:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12886:             my $path = $env{'form.archive_content_'.$i};
                   12887:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12888:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12889:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12890:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12891:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12892:                         my ($itemidx,$fullpath,$relpath);
                   12893:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12894:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12895:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  12896:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12897:                                     $itemidx = $j;
1.1056    raeburn  12898:                                 }
                   12899:                             }
1.1075.2.11  raeburn  12900:                         }
                   12901:                         if ($itemidx eq '') {
                   12902:                             $itemidx =  0;
                   12903:                         }
                   12904:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12905:                             if ($mapinner{$referrer{$i}}) {
                   12906:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12907:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12908:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12909:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12910:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12911:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12912:                                             if (!-e $fullpath) {
                   12913:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12914:                                             }
                   12915:                                         }
1.1075.2.11  raeburn  12916:                                     } else {
                   12917:                                         last;
1.1056    raeburn  12918:                                     }
1.1075.2.11  raeburn  12919:                                 }
                   12920:                             }
                   12921:                         } elsif ($newdest{$referrer{$i}}) {
                   12922:                             $fullpath = $newdest{$referrer{$i}};
                   12923:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12924:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12925:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12926:                                     last;
                   12927:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12928:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12929:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12930:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12931:                                         if (!-e $fullpath) {
                   12932:                                             mkdir($fullpath,0755);
1.1056    raeburn  12933:                                         }
                   12934:                                     }
1.1075.2.11  raeburn  12935:                                 } else {
                   12936:                                     last;
1.1056    raeburn  12937:                                 }
1.1075.2.11  raeburn  12938:                             }
                   12939:                         }
                   12940:                         if ($fullpath ne '') {
                   12941:                             if (-e "$prefix$path") {
1.1075.2.128  raeburn  12942:                                 unless (rename("$prefix$path","$fullpath/$title")) {
                   12943:                                      $warning .= &mt('Failed to rename dependency').'<br />';
                   12944:                                 }
1.1075.2.11  raeburn  12945:                             }
                   12946:                             if (-e "$fullpath/$title") {
                   12947:                                 my $showpath;
                   12948:                                 if ($relpath ne '') {
                   12949:                                     $showpath = "$relpath/$title";
                   12950:                                 } else {
                   12951:                                     $showpath = "/$title";
1.1056    raeburn  12952:                                 }
1.1075.2.128  raeburn  12953:                                 $result .= '<li>'.&mt('[_1] included as a dependency',
                   12954:                                                       &HTML::Entities::encode($showpath,'<>&"')).
                   12955:                                            '</li>'."\n";
                   12956:                                 unless ($ishome) {
                   12957:                                     my $fetch = "$fullpath/$title";
                   12958:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12959:                                     $prompttofetch{$fetch} = 1;
                   12960:                                 }
1.1055    raeburn  12961:                             }
                   12962:                         }
                   12963:                     }
1.1075.2.11  raeburn  12964:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12965:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1075.2.128  raeburn  12966:                                     &HTML::Entities::encode($path,'<>&"'),
                   12967:                                     &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
                   12968:                                 '<br />';
1.1055    raeburn  12969:                 }
                   12970:             } else {
1.1075.2.128  raeburn  12971:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   12972:                                 &HTML::Entities::encode($path)).'<br />';
1.1055    raeburn  12973:             }
                   12974:         }
                   12975:         if (keys(%todelete)) {
                   12976:             foreach my $key (keys(%todelete)) {
                   12977:                 unlink($key);
1.1066    raeburn  12978:             }
                   12979:         }
                   12980:         if (keys(%todeletedir)) {
                   12981:             foreach my $key (keys(%todeletedir)) {
                   12982:                 rmdir($key);
                   12983:             }
                   12984:         }
                   12985:         foreach my $dir (sort(keys(%is_dir))) {
                   12986:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12987:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12988:             }
                   12989:         }
1.1067    raeburn  12990:         if ($result ne '') {
                   12991:             $output .= '<ul>'."\n".
                   12992:                        $result."\n".
                   12993:                        '</ul>';
                   12994:         }
                   12995:         unless ($ishome) {
                   12996:             my $replicationfail;
                   12997:             foreach my $item (keys(%prompttofetch)) {
                   12998:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12999:                 unless ($fetchresult eq 'ok') {
                   13000:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   13001:                 }
                   13002:             }
                   13003:             if ($replicationfail) {
                   13004:                 $output .= '<p class="LC_error">'.
                   13005:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   13006:                            $replicationfail.
                   13007:                            '</ul></p>';
                   13008:             }
                   13009:         }
1.1055    raeburn  13010:     } else {
                   13011:         $warning = &mt('No items found in archive.');
                   13012:     }
                   13013:     if ($error) {
                   13014:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13015:                    $error.'</p>'."\n";
                   13016:     }
                   13017:     if ($warning) {
                   13018:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   13019:     }
                   13020:     return $output;
                   13021: }
                   13022: 
1.1066    raeburn  13023: sub cleanup_empty_dirs {
                   13024:     my ($path) = @_;
                   13025:     if (($path ne '') && (-d $path)) {
                   13026:         if (opendir(my $dirh,$path)) {
                   13027:             my @dircontents = grep(!/^\./,readdir($dirh));
                   13028:             my $numitems = 0;
                   13029:             foreach my $item (@dircontents) {
                   13030:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  13031:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  13032:                     if (-e "$path/$item") {
                   13033:                         $numitems ++;
                   13034:                     }
                   13035:                 } else {
                   13036:                     $numitems ++;
                   13037:                 }
                   13038:             }
                   13039:             if ($numitems == 0) {
                   13040:                 rmdir($path);
                   13041:             }
                   13042:             closedir($dirh);
                   13043:         }
                   13044:     }
                   13045:     return;
                   13046: }
                   13047: 
1.41      ng       13048: =pod
1.45      matthew  13049: 
1.1075.2.56  raeburn  13050: =item * &get_folder_hierarchy()
1.1068    raeburn  13051: 
                   13052: Provides hierarchy of names of folders/sub-folders containing the current
                   13053: item,
                   13054: 
                   13055: Inputs: 3
                   13056:      - $navmap - navmaps object
                   13057: 
                   13058:      - $map - url for map (either the trigger itself, or map containing
                   13059:                            the resource, which is the trigger).
                   13060: 
                   13061:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   13062: 
                   13063: Outputs: 1 @pathitems - array of folder/subfolder names.
                   13064: 
                   13065: =cut
                   13066: 
                   13067: sub get_folder_hierarchy {
                   13068:     my ($navmap,$map,$showitem) = @_;
                   13069:     my @pathitems;
                   13070:     if (ref($navmap)) {
                   13071:         my $mapres = $navmap->getResourceByUrl($map);
                   13072:         if (ref($mapres)) {
                   13073:             my $pcslist = $mapres->map_hierarchy();
                   13074:             if ($pcslist ne '') {
                   13075:                 my @pcs = split(/,/,$pcslist);
                   13076:                 foreach my $pc (@pcs) {
                   13077:                     if ($pc == 1) {
1.1075.2.38  raeburn  13078:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  13079:                     } else {
                   13080:                         my $res = $navmap->getByMapPc($pc);
                   13081:                         if (ref($res)) {
                   13082:                             my $title = $res->compTitle();
                   13083:                             $title =~ s/\W+/_/g;
                   13084:                             if ($title ne '') {
                   13085:                                 push(@pathitems,$title);
                   13086:                             }
                   13087:                         }
                   13088:                     }
                   13089:                 }
                   13090:             }
1.1071    raeburn  13091:             if ($showitem) {
                   13092:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  13093:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  13094:                 } else {
                   13095:                     my $maptitle = $mapres->compTitle();
                   13096:                     $maptitle =~ s/\W+/_/g;
                   13097:                     if ($maptitle ne '') {
                   13098:                         push(@pathitems,$maptitle);
                   13099:                     }
1.1068    raeburn  13100:                 }
                   13101:             }
                   13102:         }
                   13103:     }
                   13104:     return @pathitems;
                   13105: }
                   13106: 
                   13107: =pod
                   13108: 
1.1015    raeburn  13109: =item * &get_turnedin_filepath()
                   13110: 
                   13111: Determines path in a user's portfolio file for storage of files uploaded
                   13112: to a specific essayresponse or dropbox item.
                   13113: 
                   13114: Inputs: 3 required + 1 optional.
                   13115: $symb is symb for resource, $uname and $udom are for current user (required).
                   13116: $caller is optional (can be "submission", if routine is called when storing
                   13117: an upoaded file when "Submit Answer" button was pressed).
                   13118: 
                   13119: Returns array containing $path and $multiresp. 
                   13120: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   13121: than one file upload item.  Callers of routine should append partid as a 
                   13122: subdirectory to $path in cases where $multiresp is 1.
                   13123: 
                   13124: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   13125: 
                   13126: =cut
                   13127: 
                   13128: sub get_turnedin_filepath {
                   13129:     my ($symb,$uname,$udom,$caller) = @_;
                   13130:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   13131:     my $turnindir;
                   13132:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   13133:     $turnindir = $userhash{'turnindir'};
                   13134:     my ($path,$multiresp);
                   13135:     if ($turnindir eq '') {
                   13136:         if ($caller eq 'submission') {
                   13137:             $turnindir = &mt('turned in');
                   13138:             $turnindir =~ s/\W+/_/g;
                   13139:             my %newhash = (
                   13140:                             'turnindir' => $turnindir,
                   13141:                           );
                   13142:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   13143:         }
                   13144:     }
                   13145:     if ($turnindir ne '') {
                   13146:         $path = '/'.$turnindir.'/';
                   13147:         my ($multipart,$turnin,@pathitems);
                   13148:         my $navmap = Apache::lonnavmaps::navmap->new();
                   13149:         if (defined($navmap)) {
                   13150:             my $mapres = $navmap->getResourceByUrl($map);
                   13151:             if (ref($mapres)) {
                   13152:                 my $pcslist = $mapres->map_hierarchy();
                   13153:                 if ($pcslist ne '') {
                   13154:                     foreach my $pc (split(/,/,$pcslist)) {
                   13155:                         my $res = $navmap->getByMapPc($pc);
                   13156:                         if (ref($res)) {
                   13157:                             my $title = $res->compTitle();
                   13158:                             $title =~ s/\W+/_/g;
                   13159:                             if ($title ne '') {
1.1075.2.48  raeburn  13160:                                 if (($pc > 1) && (length($title) > 12)) {
                   13161:                                     $title = substr($title,0,12);
                   13162:                                 }
1.1015    raeburn  13163:                                 push(@pathitems,$title);
                   13164:                             }
                   13165:                         }
                   13166:                     }
                   13167:                 }
                   13168:                 my $maptitle = $mapres->compTitle();
                   13169:                 $maptitle =~ s/\W+/_/g;
                   13170:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  13171:                     if (length($maptitle) > 12) {
                   13172:                         $maptitle = substr($maptitle,0,12);
                   13173:                     }
1.1015    raeburn  13174:                     push(@pathitems,$maptitle);
                   13175:                 }
                   13176:                 unless ($env{'request.state'} eq 'construct') {
                   13177:                     my $res = $navmap->getBySymb($symb);
                   13178:                     if (ref($res)) {
                   13179:                         my $partlist = $res->parts();
                   13180:                         my $totaluploads = 0;
                   13181:                         if (ref($partlist) eq 'ARRAY') {
                   13182:                             foreach my $part (@{$partlist}) {
                   13183:                                 my @types = $res->responseType($part);
                   13184:                                 my @ids = $res->responseIds($part);
                   13185:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   13186:                                     if ($types[$i] eq 'essay') {
                   13187:                                         my $partid = $part.'_'.$ids[$i];
                   13188:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   13189:                                             $totaluploads ++;
                   13190:                                         }
                   13191:                                     }
                   13192:                                 }
                   13193:                             }
                   13194:                             if ($totaluploads > 1) {
                   13195:                                 $multiresp = 1;
                   13196:                             }
                   13197:                         }
                   13198:                     }
                   13199:                 }
                   13200:             } else {
                   13201:                 return;
                   13202:             }
                   13203:         } else {
                   13204:             return;
                   13205:         }
                   13206:         my $restitle=&Apache::lonnet::gettitle($symb);
                   13207:         $restitle =~ s/\W+/_/g;
                   13208:         if ($restitle eq '') {
                   13209:             $restitle = ($resurl =~ m{/[^/]+$});
                   13210:             if ($restitle eq '') {
                   13211:                 $restitle = time;
                   13212:             }
                   13213:         }
1.1075.2.48  raeburn  13214:         if (length($restitle) > 12) {
                   13215:             $restitle = substr($restitle,0,12);
                   13216:         }
1.1015    raeburn  13217:         push(@pathitems,$restitle);
                   13218:         $path .= join('/',@pathitems);
                   13219:     }
                   13220:     return ($path,$multiresp);
                   13221: }
                   13222: 
                   13223: =pod
                   13224: 
1.464     albertel 13225: =back
1.41      ng       13226: 
1.112     bowersj2 13227: =head1 CSV Upload/Handling functions
1.38      albertel 13228: 
1.41      ng       13229: =over 4
                   13230: 
1.648     raeburn  13231: =item * &upfile_store($r)
1.41      ng       13232: 
                   13233: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 13234: needs $env{'form.upfile'}
1.41      ng       13235: returns $datatoken to be put into hidden field
                   13236: 
                   13237: =cut
1.31      albertel 13238: 
                   13239: sub upfile_store {
                   13240:     my $r=shift;
1.258     albertel 13241:     $env{'form.upfile'}=~s/\r/\n/gs;
                   13242:     $env{'form.upfile'}=~s/\f/\n/gs;
                   13243:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   13244:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 13245: 
1.1075.2.128  raeburn  13246:     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
                   13247:                                      '_enroll_'.$env{'request.course.id'}.'_'.
                   13248:                                      time.'_'.$$);
                   13249:     return if ($datatoken eq '');
                   13250: 
1.31      albertel 13251:     {
1.158     raeburn  13252:         my $datafile = $r->dir_config('lonDaemons').
                   13253:                            '/tmp/'.$datatoken.'.tmp';
1.1075.2.128  raeburn  13254:         if ( open(my $fh,'>',$datafile) ) {
1.258     albertel 13255:             print $fh $env{'form.upfile'};
1.158     raeburn  13256:             close($fh);
                   13257:         }
1.31      albertel 13258:     }
                   13259:     return $datatoken;
                   13260: }
                   13261: 
1.56      matthew  13262: =pod
                   13263: 
1.1075.2.128  raeburn  13264: =item * &load_tmp_file($r,$datatoken)
1.41      ng       13265: 
                   13266: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1075.2.128  raeburn  13267: $datatoken is the name to assign to the temporary file.
1.258     albertel 13268: sets $env{'form.upfile'} to the contents of the file
1.41      ng       13269: 
                   13270: =cut
1.31      albertel 13271: 
                   13272: sub load_tmp_file {
1.1075.2.128  raeburn  13273:     my ($r,$datatoken) = @_;
                   13274:     return if ($datatoken eq '');
1.31      albertel 13275:     my @studentdata=();
                   13276:     {
1.158     raeburn  13277:         my $studentfile = $r->dir_config('lonDaemons').
1.1075.2.128  raeburn  13278:                               '/tmp/'.$datatoken.'.tmp';
                   13279:         if ( open(my $fh,'<',$studentfile) ) {
1.158     raeburn  13280:             @studentdata=<$fh>;
                   13281:             close($fh);
                   13282:         }
1.31      albertel 13283:     }
1.258     albertel 13284:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 13285: }
                   13286: 
1.1075.2.128  raeburn  13287: sub valid_datatoken {
                   13288:     my ($datatoken) = @_;
1.1075.2.131  raeburn  13289:     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1075.2.128  raeburn  13290:         return $datatoken;
                   13291:     }
                   13292:     return;
                   13293: }
                   13294: 
1.56      matthew  13295: =pod
                   13296: 
1.648     raeburn  13297: =item * &upfile_record_sep()
1.41      ng       13298: 
                   13299: Separate uploaded file into records
                   13300: returns array of records,
1.258     albertel 13301: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       13302: 
                   13303: =cut
1.31      albertel 13304: 
                   13305: sub upfile_record_sep {
1.258     albertel 13306:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 13307:     } else {
1.248     albertel 13308: 	my @records;
1.258     albertel 13309: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 13310: 	    if ($line=~/^\s*$/) { next; }
                   13311: 	    push(@records,$line);
                   13312: 	}
                   13313: 	return @records;
1.31      albertel 13314:     }
                   13315: }
                   13316: 
1.56      matthew  13317: =pod
                   13318: 
1.648     raeburn  13319: =item * &record_sep($record)
1.41      ng       13320: 
1.258     albertel 13321: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       13322: 
                   13323: =cut
                   13324: 
1.263     www      13325: sub takeleft {
                   13326:     my $index=shift;
                   13327:     return substr('0000'.$index,-4,4);
                   13328: }
                   13329: 
1.31      albertel 13330: sub record_sep {
                   13331:     my $record=shift;
                   13332:     my %components=();
1.258     albertel 13333:     if ($env{'form.upfiletype'} eq 'xml') {
                   13334:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 13335:         my $i=0;
1.356     albertel 13336:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 13337:             $field=~s/^(\"|\')//;
                   13338:             $field=~s/(\"|\')$//;
1.263     www      13339:             $components{&takeleft($i)}=$field;
1.31      albertel 13340:             $i++;
                   13341:         }
1.258     albertel 13342:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 13343:         my $i=0;
1.356     albertel 13344:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 13345:             $field=~s/^(\"|\')//;
                   13346:             $field=~s/(\"|\')$//;
1.263     www      13347:             $components{&takeleft($i)}=$field;
1.31      albertel 13348:             $i++;
                   13349:         }
                   13350:     } else {
1.561     www      13351:         my $separator=',';
1.480     banghart 13352:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      13353:             $separator=';';
1.480     banghart 13354:         }
1.31      albertel 13355:         my $i=0;
1.561     www      13356: # the character we are looking for to indicate the end of a quote or a record 
                   13357:         my $looking_for=$separator;
                   13358: # do not add the characters to the fields
                   13359:         my $ignore=0;
                   13360: # we just encountered a separator (or the beginning of the record)
                   13361:         my $just_found_separator=1;
                   13362: # store the field we are working on here
                   13363:         my $field='';
                   13364: # work our way through all characters in record
                   13365:         foreach my $character ($record=~/(.)/g) {
                   13366:             if ($character eq $looking_for) {
                   13367:                if ($character ne $separator) {
                   13368: # Found the end of a quote, again looking for separator
                   13369:                   $looking_for=$separator;
                   13370:                   $ignore=1;
                   13371:                } else {
                   13372: # Found a separator, store away what we got
                   13373:                   $components{&takeleft($i)}=$field;
                   13374: 	          $i++;
                   13375:                   $just_found_separator=1;
                   13376:                   $ignore=0;
                   13377:                   $field='';
                   13378:                }
                   13379:                next;
                   13380:             }
                   13381: # single or double quotation marks after a separator indicate beginning of a quote
                   13382: # we are now looking for the end of the quote and need to ignore separators
                   13383:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   13384:                $looking_for=$character;
                   13385:                next;
                   13386:             }
                   13387: # ignore would be true after we reached the end of a quote
                   13388:             if ($ignore) { next; }
                   13389:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   13390:             $field.=$character;
                   13391:             $just_found_separator=0; 
1.31      albertel 13392:         }
1.561     www      13393: # catch the very last entry, since we never encountered the separator
                   13394:         $components{&takeleft($i)}=$field;
1.31      albertel 13395:     }
                   13396:     return %components;
                   13397: }
                   13398: 
1.144     matthew  13399: ######################################################
                   13400: ######################################################
                   13401: 
1.56      matthew  13402: =pod
                   13403: 
1.648     raeburn  13404: =item * &upfile_select_html()
1.41      ng       13405: 
1.144     matthew  13406: Return HTML code to select a file from the users machine and specify 
                   13407: the file type.
1.41      ng       13408: 
                   13409: =cut
                   13410: 
1.144     matthew  13411: ######################################################
                   13412: ######################################################
1.31      albertel 13413: sub upfile_select_html {
1.144     matthew  13414:     my %Types = (
                   13415:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 13416:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  13417:                  space => &mt('Space separated'),
                   13418:                  tab   => &mt('Tabulator separated'),
                   13419: #                 xml   => &mt('HTML/XML'),
                   13420:                  );
                   13421:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  13422:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  13423:     foreach my $type (sort(keys(%Types))) {
                   13424:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   13425:     }
                   13426:     $Str .= "</select>\n";
                   13427:     return $Str;
1.31      albertel 13428: }
                   13429: 
1.301     albertel 13430: sub get_samples {
                   13431:     my ($records,$toget) = @_;
                   13432:     my @samples=({});
                   13433:     my $got=0;
                   13434:     foreach my $rec (@$records) {
                   13435: 	my %temp = &record_sep($rec);
                   13436: 	if (! grep(/\S/, values(%temp))) { next; }
                   13437: 	if (%temp) {
                   13438: 	    $samples[$got]=\%temp;
                   13439: 	    $got++;
                   13440: 	    if ($got == $toget) { last; }
                   13441: 	}
                   13442:     }
                   13443:     return \@samples;
                   13444: }
                   13445: 
1.144     matthew  13446: ######################################################
                   13447: ######################################################
                   13448: 
1.56      matthew  13449: =pod
                   13450: 
1.648     raeburn  13451: =item * &csv_print_samples($r,$records)
1.41      ng       13452: 
                   13453: Prints a table of sample values from each column uploaded $r is an
                   13454: Apache Request ref, $records is an arrayref from
                   13455: &Apache::loncommon::upfile_record_sep
                   13456: 
                   13457: =cut
                   13458: 
1.144     matthew  13459: ######################################################
                   13460: ######################################################
1.31      albertel 13461: sub csv_print_samples {
                   13462:     my ($r,$records) = @_;
1.662     bisitz   13463:     my $samples = &get_samples($records,5);
1.301     albertel 13464: 
1.594     raeburn  13465:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   13466:               &start_data_table_header_row());
1.356     albertel 13467:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   13468:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  13469:     $r->print(&end_data_table_header_row());
1.301     albertel 13470:     foreach my $hash (@$samples) {
1.594     raeburn  13471: 	$r->print(&start_data_table_row());
1.356     albertel 13472: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 13473: 	    $r->print('<td>');
1.356     albertel 13474: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 13475: 	    $r->print('</td>');
                   13476: 	}
1.594     raeburn  13477: 	$r->print(&end_data_table_row());
1.31      albertel 13478:     }
1.594     raeburn  13479:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 13480: }
                   13481: 
1.144     matthew  13482: ######################################################
                   13483: ######################################################
                   13484: 
1.56      matthew  13485: =pod
                   13486: 
1.648     raeburn  13487: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       13488: 
                   13489: Prints a table to create associations between values and table columns.
1.144     matthew  13490: 
1.41      ng       13491: $r is an Apache Request ref,
                   13492: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  13493: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       13494: 
                   13495: =cut
                   13496: 
1.144     matthew  13497: ######################################################
                   13498: ######################################################
1.31      albertel 13499: sub csv_print_select_table {
                   13500:     my ($r,$records,$d) = @_;
1.301     albertel 13501:     my $i=0;
                   13502:     my $samples = &get_samples($records,1);
1.144     matthew  13503:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  13504: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  13505:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  13506:               '<th>'.&mt('Column').'</th>'.
                   13507:               &end_data_table_header_row()."\n");
1.356     albertel 13508:     foreach my $array_ref (@$d) {
                   13509: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  13510: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 13511: 
1.875     bisitz   13512: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  13513: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 13514: 	$r->print('<option value="none"></option>');
1.356     albertel 13515: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   13516: 	    $r->print('<option value="'.$sample.'"'.
                   13517:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   13518:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 13519: 	}
1.594     raeburn  13520: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 13521: 	$i++;
                   13522:     }
1.594     raeburn  13523:     $r->print(&end_data_table());
1.31      albertel 13524:     $i--;
                   13525:     return $i;
                   13526: }
1.56      matthew  13527: 
1.144     matthew  13528: ######################################################
                   13529: ######################################################
                   13530: 
1.56      matthew  13531: =pod
1.31      albertel 13532: 
1.648     raeburn  13533: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       13534: 
                   13535: Prints a table of sample values from the upload and can make associate samples to internal names.
                   13536: 
                   13537: $r is an Apache Request ref,
                   13538: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   13539: $d is an array of 2 element arrays (internal name, displayed name)
                   13540: 
                   13541: =cut
                   13542: 
1.144     matthew  13543: ######################################################
                   13544: ######################################################
1.31      albertel 13545: sub csv_samples_select_table {
                   13546:     my ($r,$records,$d) = @_;
                   13547:     my $i=0;
1.144     matthew  13548:     #
1.662     bisitz   13549:     my $max_samples = 5;
                   13550:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  13551:     $r->print(&start_data_table().
                   13552:               &start_data_table_header_row().'<th>'.
                   13553:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   13554:               &end_data_table_header_row());
1.301     albertel 13555: 
                   13556:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  13557: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  13558: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 13559: 	foreach my $option (@$d) {
                   13560: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  13561: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 13562:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  13563:                       $display.'</option>');
1.31      albertel 13564: 	}
                   13565: 	$r->print('</select></td><td>');
1.662     bisitz   13566: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 13567: 	    if (defined($samples->[$line]{$key})) { 
                   13568: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   13569: 	    }
                   13570: 	}
1.594     raeburn  13571: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 13572: 	$i++;
                   13573:     }
1.594     raeburn  13574:     $r->print(&end_data_table());
1.31      albertel 13575:     $i--;
                   13576:     return($i);
1.115     matthew  13577: }
                   13578: 
1.144     matthew  13579: ######################################################
                   13580: ######################################################
                   13581: 
1.115     matthew  13582: =pod
                   13583: 
1.648     raeburn  13584: =item * &clean_excel_name($name)
1.115     matthew  13585: 
                   13586: Returns a replacement for $name which does not contain any illegal characters.
                   13587: 
                   13588: =cut
                   13589: 
1.144     matthew  13590: ######################################################
                   13591: ######################################################
1.115     matthew  13592: sub clean_excel_name {
                   13593:     my ($name) = @_;
                   13594:     $name =~ s/[:\*\?\/\\]//g;
                   13595:     if (length($name) > 31) {
                   13596:         $name = substr($name,0,31);
                   13597:     }
                   13598:     return $name;
1.25      albertel 13599: }
1.84      albertel 13600: 
1.85      albertel 13601: =pod
                   13602: 
1.648     raeburn  13603: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 13604: 
                   13605: Returns either 1 or undef
                   13606: 
                   13607: 1 if the part is to be hidden, undef if it is to be shown
                   13608: 
                   13609: Arguments are:
                   13610: 
                   13611: $id the id of the part to be checked
                   13612: $symb, optional the symb of the resource to check
                   13613: $udom, optional the domain of the user to check for
                   13614: $uname, optional the username of the user to check for
                   13615: 
                   13616: =cut
1.84      albertel 13617: 
                   13618: sub check_if_partid_hidden {
                   13619:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 13620:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 13621: 					 $symb,$udom,$uname);
1.141     albertel 13622:     my $truth=1;
                   13623:     #if the string starts with !, then the list is the list to show not hide
                   13624:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 13625:     my @hiddenlist=split(/,/,$hiddenparts);
                   13626:     foreach my $checkid (@hiddenlist) {
1.141     albertel 13627: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 13628:     }
1.141     albertel 13629:     return !$truth;
1.84      albertel 13630: }
1.127     matthew  13631: 
1.138     matthew  13632: 
                   13633: ############################################################
                   13634: ############################################################
                   13635: 
                   13636: =pod
                   13637: 
1.157     matthew  13638: =back 
                   13639: 
1.138     matthew  13640: =head1 cgi-bin script and graphing routines
                   13641: 
1.157     matthew  13642: =over 4
                   13643: 
1.648     raeburn  13644: =item * &get_cgi_id()
1.138     matthew  13645: 
                   13646: Inputs: none
                   13647: 
                   13648: Returns an id which can be used to pass environment variables
                   13649: to various cgi-bin scripts.  These environment variables will
                   13650: be removed from the users environment after a given time by
                   13651: the routine &Apache::lonnet::transfer_profile_to_env.
                   13652: 
                   13653: =cut
                   13654: 
                   13655: ############################################################
                   13656: ############################################################
1.152     albertel 13657: my $uniq=0;
1.136     matthew  13658: sub get_cgi_id {
1.154     albertel 13659:     $uniq=($uniq+1)%100000;
1.280     albertel 13660:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  13661: }
                   13662: 
1.127     matthew  13663: ############################################################
                   13664: ############################################################
                   13665: 
                   13666: =pod
                   13667: 
1.648     raeburn  13668: =item * &DrawBarGraph()
1.127     matthew  13669: 
1.138     matthew  13670: Facilitates the plotting of data in a (stacked) bar graph.
                   13671: Puts plot definition data into the users environment in order for 
                   13672: graph.png to plot it.  Returns an <img> tag for the plot.
                   13673: The bars on the plot are labeled '1','2',...,'n'.
                   13674: 
                   13675: Inputs:
                   13676: 
                   13677: =over 4
                   13678: 
                   13679: =item $Title: string, the title of the plot
                   13680: 
                   13681: =item $xlabel: string, text describing the X-axis of the plot
                   13682: 
                   13683: =item $ylabel: string, text describing the Y-axis of the plot
                   13684: 
                   13685: =item $Max: scalar, the maximum Y value to use in the plot
                   13686: If $Max is < any data point, the graph will not be rendered.
                   13687: 
1.140     matthew  13688: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  13689: they are plotted.  If undefined, default values will be used.
                   13690: 
1.178     matthew  13691: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   13692: 
1.138     matthew  13693: =item @Values: An array of array references.  Each array reference holds data
                   13694: to be plotted in a stacked bar chart.
                   13695: 
1.239     matthew  13696: =item If the final element of @Values is a hash reference the key/value
                   13697: pairs will be added to the graph definition.
                   13698: 
1.138     matthew  13699: =back
                   13700: 
                   13701: Returns:
                   13702: 
                   13703: An <img> tag which references graph.png and the appropriate identifying
                   13704: information for the plot.
                   13705: 
1.127     matthew  13706: =cut
                   13707: 
                   13708: ############################################################
                   13709: ############################################################
1.134     matthew  13710: sub DrawBarGraph {
1.178     matthew  13711:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  13712:     #
                   13713:     if (! defined($colors)) {
                   13714:         $colors = ['#33ff00', 
                   13715:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   13716:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   13717:                   ]; 
                   13718:     }
1.228     matthew  13719:     my $extra_settings = {};
                   13720:     if (ref($Values[-1]) eq 'HASH') {
                   13721:         $extra_settings = pop(@Values);
                   13722:     }
1.127     matthew  13723:     #
1.136     matthew  13724:     my $identifier = &get_cgi_id();
                   13725:     my $id = 'cgi.'.$identifier;        
1.129     matthew  13726:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  13727:         return '';
                   13728:     }
1.225     matthew  13729:     #
                   13730:     my @Labels;
                   13731:     if (defined($labels)) {
                   13732:         @Labels = @$labels;
                   13733:     } else {
                   13734:         for (my $i=0;$i<@{$Values[0]};$i++) {
1.1075.2.119  raeburn  13735:             push(@Labels,$i+1);
1.225     matthew  13736:         }
                   13737:     }
                   13738:     #
1.129     matthew  13739:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  13740:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  13741:     my %ValuesHash;
                   13742:     my $NumSets=1;
                   13743:     foreach my $array (@Values) {
                   13744:         next if (! ref($array));
1.136     matthew  13745:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  13746:             join(',',@$array);
1.129     matthew  13747:     }
1.127     matthew  13748:     #
1.136     matthew  13749:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  13750:     if ($NumBars < 3) {
                   13751:         $width = 120+$NumBars*32;
1.220     matthew  13752:         $xskip = 1;
1.225     matthew  13753:         $bar_width = 30;
                   13754:     } elsif ($NumBars < 5) {
                   13755:         $width = 120+$NumBars*20;
                   13756:         $xskip = 1;
                   13757:         $bar_width = 20;
1.220     matthew  13758:     } elsif ($NumBars < 10) {
1.136     matthew  13759:         $width = 120+$NumBars*15;
                   13760:         $xskip = 1;
                   13761:         $bar_width = 15;
                   13762:     } elsif ($NumBars <= 25) {
                   13763:         $width = 120+$NumBars*11;
                   13764:         $xskip = 5;
                   13765:         $bar_width = 8;
                   13766:     } elsif ($NumBars <= 50) {
                   13767:         $width = 120+$NumBars*8;
                   13768:         $xskip = 5;
                   13769:         $bar_width = 4;
                   13770:     } else {
                   13771:         $width = 120+$NumBars*8;
                   13772:         $xskip = 5;
                   13773:         $bar_width = 4;
                   13774:     }
                   13775:     #
1.137     matthew  13776:     $Max = 1 if ($Max < 1);
                   13777:     if ( int($Max) < $Max ) {
                   13778:         $Max++;
                   13779:         $Max = int($Max);
                   13780:     }
1.127     matthew  13781:     $Title  = '' if (! defined($Title));
                   13782:     $xlabel = '' if (! defined($xlabel));
                   13783:     $ylabel = '' if (! defined($ylabel));
1.369     www      13784:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   13785:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   13786:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  13787:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  13788:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   13789:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   13790:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   13791:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13792:     $ValuesHash{$id.'.height'}   = $height;
                   13793:     $ValuesHash{$id.'.width'}    = $width;
                   13794:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   13795:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   13796:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  13797:     #
1.228     matthew  13798:     # Deal with other parameters
                   13799:     while (my ($key,$value) = each(%$extra_settings)) {
                   13800:         $ValuesHash{$id.'.'.$key} = $value;
                   13801:     }
                   13802:     #
1.646     raeburn  13803:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  13804:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13805: }
                   13806: 
                   13807: ############################################################
                   13808: ############################################################
                   13809: 
                   13810: =pod
                   13811: 
1.648     raeburn  13812: =item * &DrawXYGraph()
1.137     matthew  13813: 
1.138     matthew  13814: Facilitates the plotting of data in an XY graph.
                   13815: Puts plot definition data into the users environment in order for 
                   13816: graph.png to plot it.  Returns an <img> tag for the plot.
                   13817: 
                   13818: Inputs:
                   13819: 
                   13820: =over 4
                   13821: 
                   13822: =item $Title: string, the title of the plot
                   13823: 
                   13824: =item $xlabel: string, text describing the X-axis of the plot
                   13825: 
                   13826: =item $ylabel: string, text describing the Y-axis of the plot
                   13827: 
                   13828: =item $Max: scalar, the maximum Y value to use in the plot
                   13829: If $Max is < any data point, the graph will not be rendered.
                   13830: 
                   13831: =item $colors: Array ref containing the hex color codes for the data to be 
                   13832: plotted in.  If undefined, default values will be used.
                   13833: 
                   13834: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13835: 
                   13836: =item $Ydata: Array ref containing Array refs.  
1.185     www      13837: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  13838: 
                   13839: =item %Values: hash indicating or overriding any default values which are 
                   13840: passed to graph.png.  
                   13841: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13842: 
                   13843: =back
                   13844: 
                   13845: Returns:
                   13846: 
                   13847: An <img> tag which references graph.png and the appropriate identifying
                   13848: information for the plot.
                   13849: 
1.137     matthew  13850: =cut
                   13851: 
                   13852: ############################################################
                   13853: ############################################################
                   13854: sub DrawXYGraph {
                   13855:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   13856:     #
                   13857:     # Create the identifier for the graph
                   13858:     my $identifier = &get_cgi_id();
                   13859:     my $id = 'cgi.'.$identifier;
                   13860:     #
                   13861:     $Title  = '' if (! defined($Title));
                   13862:     $xlabel = '' if (! defined($xlabel));
                   13863:     $ylabel = '' if (! defined($ylabel));
                   13864:     my %ValuesHash = 
                   13865:         (
1.369     www      13866:          $id.'.title'  => &escape($Title),
                   13867:          $id.'.xlabel' => &escape($xlabel),
                   13868:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  13869:          $id.'.y_max_value'=> $Max,
                   13870:          $id.'.labels'     => join(',',@$Xlabels),
                   13871:          $id.'.PlotType'   => 'XY',
                   13872:          );
                   13873:     #
                   13874:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13875:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13876:     }
                   13877:     #
                   13878:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13879:         return '';
                   13880:     }
                   13881:     my $NumSets=1;
1.138     matthew  13882:     foreach my $array (@{$Ydata}){
1.137     matthew  13883:         next if (! ref($array));
                   13884:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13885:     }
1.138     matthew  13886:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13887:     #
                   13888:     # Deal with other parameters
                   13889:     while (my ($key,$value) = each(%Values)) {
                   13890:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13891:     }
                   13892:     #
1.646     raeburn  13893:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13894:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13895: }
                   13896: 
                   13897: ############################################################
                   13898: ############################################################
                   13899: 
                   13900: =pod
                   13901: 
1.648     raeburn  13902: =item * &DrawXYYGraph()
1.138     matthew  13903: 
                   13904: Facilitates the plotting of data in an XY graph with two Y axes.
                   13905: Puts plot definition data into the users environment in order for 
                   13906: graph.png to plot it.  Returns an <img> tag for the plot.
                   13907: 
                   13908: Inputs:
                   13909: 
                   13910: =over 4
                   13911: 
                   13912: =item $Title: string, the title of the plot
                   13913: 
                   13914: =item $xlabel: string, text describing the X-axis of the plot
                   13915: 
                   13916: =item $ylabel: string, text describing the Y-axis of the plot
                   13917: 
                   13918: =item $colors: Array ref containing the hex color codes for the data to be 
                   13919: plotted in.  If undefined, default values will be used.
                   13920: 
                   13921: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13922: 
                   13923: =item $Ydata1: The first data set
                   13924: 
                   13925: =item $Min1: The minimum value of the left Y-axis
                   13926: 
                   13927: =item $Max1: The maximum value of the left Y-axis
                   13928: 
                   13929: =item $Ydata2: The second data set
                   13930: 
                   13931: =item $Min2: The minimum value of the right Y-axis
                   13932: 
                   13933: =item $Max2: The maximum value of the left Y-axis
                   13934: 
                   13935: =item %Values: hash indicating or overriding any default values which are 
                   13936: passed to graph.png.  
                   13937: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13938: 
                   13939: =back
                   13940: 
                   13941: Returns:
                   13942: 
                   13943: An <img> tag which references graph.png and the appropriate identifying
                   13944: information for the plot.
1.136     matthew  13945: 
                   13946: =cut
                   13947: 
                   13948: ############################################################
                   13949: ############################################################
1.137     matthew  13950: sub DrawXYYGraph {
                   13951:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13952:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13953:     #
                   13954:     # Create the identifier for the graph
                   13955:     my $identifier = &get_cgi_id();
                   13956:     my $id = 'cgi.'.$identifier;
                   13957:     #
                   13958:     $Title  = '' if (! defined($Title));
                   13959:     $xlabel = '' if (! defined($xlabel));
                   13960:     $ylabel = '' if (! defined($ylabel));
                   13961:     my %ValuesHash = 
                   13962:         (
1.369     www      13963:          $id.'.title'  => &escape($Title),
                   13964:          $id.'.xlabel' => &escape($xlabel),
                   13965:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13966:          $id.'.labels' => join(',',@$Xlabels),
                   13967:          $id.'.PlotType' => 'XY',
                   13968:          $id.'.NumSets' => 2,
1.137     matthew  13969:          $id.'.two_axes' => 1,
                   13970:          $id.'.y1_max_value' => $Max1,
                   13971:          $id.'.y1_min_value' => $Min1,
                   13972:          $id.'.y2_max_value' => $Max2,
                   13973:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13974:          );
                   13975:     #
1.137     matthew  13976:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13977:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13978:     }
                   13979:     #
                   13980:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13981:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13982:         return '';
                   13983:     }
                   13984:     my $NumSets=1;
1.137     matthew  13985:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13986:         next if (! ref($array));
                   13987:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13988:     }
                   13989:     #
                   13990:     # Deal with other parameters
                   13991:     while (my ($key,$value) = each(%Values)) {
                   13992:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13993:     }
                   13994:     #
1.646     raeburn  13995:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13996:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13997: }
                   13998: 
                   13999: ############################################################
                   14000: ############################################################
                   14001: 
                   14002: =pod
                   14003: 
1.157     matthew  14004: =back 
                   14005: 
1.139     matthew  14006: =head1 Statistics helper routines?  
                   14007: 
                   14008: Bad place for them but what the hell.
                   14009: 
1.157     matthew  14010: =over 4
                   14011: 
1.648     raeburn  14012: =item * &chartlink()
1.139     matthew  14013: 
                   14014: Returns a link to the chart for a specific student.  
                   14015: 
                   14016: Inputs:
                   14017: 
                   14018: =over 4
                   14019: 
                   14020: =item $linktext: The text of the link
                   14021: 
                   14022: =item $sname: The students username
                   14023: 
                   14024: =item $sdomain: The students domain
                   14025: 
                   14026: =back
                   14027: 
1.157     matthew  14028: =back
                   14029: 
1.139     matthew  14030: =cut
                   14031: 
                   14032: ############################################################
                   14033: ############################################################
                   14034: sub chartlink {
                   14035:     my ($linktext, $sname, $sdomain) = @_;
                   14036:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      14037:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 14038:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  14039:        '">'.$linktext.'</a>';
1.153     matthew  14040: }
                   14041: 
                   14042: #######################################################
                   14043: #######################################################
                   14044: 
                   14045: =pod
                   14046: 
                   14047: =head1 Course Environment Routines
1.157     matthew  14048: 
                   14049: =over 4
1.153     matthew  14050: 
1.648     raeburn  14051: =item * &restore_course_settings()
1.153     matthew  14052: 
1.648     raeburn  14053: =item * &store_course_settings()
1.153     matthew  14054: 
                   14055: Restores/Store indicated form parameters from the course environment.
                   14056: Will not overwrite existing values of the form parameters.
                   14057: 
                   14058: Inputs: 
                   14059: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   14060: 
                   14061: a hash ref describing the data to be stored.  For example:
                   14062:    
                   14063: %Save_Parameters = ('Status' => 'scalar',
                   14064:     'chartoutputmode' => 'scalar',
                   14065:     'chartoutputdata' => 'scalar',
                   14066:     'Section' => 'array',
1.373     raeburn  14067:     'Group' => 'array',
1.153     matthew  14068:     'StudentData' => 'array',
                   14069:     'Maps' => 'array');
                   14070: 
                   14071: Returns: both routines return nothing
                   14072: 
1.631     raeburn  14073: =back
                   14074: 
1.153     matthew  14075: =cut
                   14076: 
                   14077: #######################################################
                   14078: #######################################################
                   14079: sub store_course_settings {
1.496     albertel 14080:     return &store_settings($env{'request.course.id'},@_);
                   14081: }
                   14082: 
                   14083: sub store_settings {
1.153     matthew  14084:     # save to the environment
                   14085:     # appenv the same items, just to be safe
1.300     albertel 14086:     my $udom  = $env{'user.domain'};
                   14087:     my $uname = $env{'user.name'};
1.496     albertel 14088:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14089:     my %SaveHash;
                   14090:     my %AppHash;
                   14091:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 14092:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 14093:         my $envname = 'environment.'.$basename;
1.258     albertel 14094:         if (exists($env{'form.'.$setting})) {
1.153     matthew  14095:             # Save this value away
                   14096:             if ($type eq 'scalar' &&
1.258     albertel 14097:                 (! exists($env{$envname}) || 
                   14098:                  $env{$envname} ne $env{'form.'.$setting})) {
                   14099:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   14100:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  14101:             } elsif ($type eq 'array') {
                   14102:                 my $stored_form;
1.258     albertel 14103:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  14104:                     $stored_form = join(',',
                   14105:                                         map {
1.369     www      14106:                                             &escape($_);
1.258     albertel 14107:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  14108:                 } else {
                   14109:                     $stored_form = 
1.369     www      14110:                         &escape($env{'form.'.$setting});
1.153     matthew  14111:                 }
                   14112:                 # Determine if the array contents are the same.
1.258     albertel 14113:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  14114:                     $SaveHash{$basename} = $stored_form;
                   14115:                     $AppHash{$envname}   = $stored_form;
                   14116:                 }
                   14117:             }
                   14118:         }
                   14119:     }
                   14120:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 14121:                                           $udom,$uname);
1.153     matthew  14122:     if ($put_result !~ /^(ok|delayed)/) {
                   14123:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   14124:                                  'got error:'.$put_result);
                   14125:     }
                   14126:     # Make sure these settings stick around in this session, too
1.646     raeburn  14127:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  14128:     return;
                   14129: }
                   14130: 
                   14131: sub restore_course_settings {
1.499     albertel 14132:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 14133: }
                   14134: 
                   14135: sub restore_settings {
                   14136:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14137:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 14138:         next if (exists($env{'form.'.$setting}));
1.496     albertel 14139:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  14140:             '.'.$setting;
1.258     albertel 14141:         if (exists($env{$envname})) {
1.153     matthew  14142:             if ($type eq 'scalar') {
1.258     albertel 14143:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  14144:             } elsif ($type eq 'array') {
1.258     albertel 14145:                 $env{'form.'.$setting} = [ 
1.153     matthew  14146:                                            map { 
1.369     www      14147:                                                &unescape($_); 
1.258     albertel 14148:                                            } split(',',$env{$envname})
1.153     matthew  14149:                                            ];
                   14150:             }
                   14151:         }
                   14152:     }
1.127     matthew  14153: }
                   14154: 
1.618     raeburn  14155: #######################################################
                   14156: #######################################################
                   14157: 
                   14158: =pod
                   14159: 
                   14160: =head1 Domain E-mail Routines  
                   14161: 
                   14162: =over 4
                   14163: 
1.648     raeburn  14164: =item * &build_recipient_list()
1.618     raeburn  14165: 
1.1075.2.44  raeburn  14166: Build recipient lists for following types of e-mail:
1.766     raeburn  14167: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  14168: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   14169: module change checking, student/employee ID conflict checks, as
                   14170: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   14171: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  14172: 
                   14173: Inputs:
1.1075.2.44  raeburn  14174: defmail (scalar - email address of default recipient),
                   14175: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   14176: requestsmail, updatesmail, or idconflictsmail).
                   14177: 
1.619     raeburn  14178: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  14179: 
                   14180: origmail (scalar - email address of recipient from loncapa.conf,
                   14181: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  14182: 
1.1075.2.139! raeburn  14183: $requname username of requester (if mailing type is helpdeskmail)
        !          14184: 
        !          14185: $requdom domain of requester (if mailing type is helpdeskmail)
        !          14186: 
        !          14187: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
        !          14188: 
1.655     raeburn  14189: Returns: comma separated list of addresses to which to send e-mail.
                   14190: 
                   14191: =back
1.618     raeburn  14192: 
                   14193: =cut
                   14194: 
                   14195: ############################################################
                   14196: ############################################################
                   14197: sub build_recipient_list {
1.1075.2.139! raeburn  14198:     my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618     raeburn  14199:     my @recipients;
1.1075.2.122  raeburn  14200:     my ($otheremails,$lastresort,$allbcc,$addtext);
1.618     raeburn  14201:     my %domconfig =
1.1075.2.122  raeburn  14202:         &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618     raeburn  14203:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  14204:         if (exists($domconfig{'contacts'}{$mailing})) {
                   14205:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   14206:                 my @contacts = ('adminemail','supportemail');
                   14207:                 foreach my $item (@contacts) {
                   14208:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   14209:                         my $addr = $domconfig{'contacts'}{$item}; 
                   14210:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14211:                             push(@recipients,$addr);
                   14212:                         }
1.619     raeburn  14213:                     }
1.1075.2.122  raeburn  14214:                 }
                   14215:                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   14216:                 if ($mailing eq 'helpdeskmail') {
                   14217:                     if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                   14218:                         my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                   14219:                         my @ok_bccs;
                   14220:                         foreach my $bcc (@bccs) {
                   14221:                             $bcc =~ s/^\s+//g;
                   14222:                             $bcc =~ s/\s+$//g;
                   14223:                             if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   14224:                                 if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   14225:                                     push(@ok_bccs,$bcc);
                   14226:                                 }
                   14227:                             }
                   14228:                         }
                   14229:                         if (@ok_bccs > 0) {
                   14230:                             $allbcc = join(', ',@ok_bccs);
                   14231:                         }
                   14232:                     }
                   14233:                     $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618     raeburn  14234:                 }
                   14235:             }
1.766     raeburn  14236:         } elsif ($origmail ne '') {
1.1075.2.122  raeburn  14237:             $lastresort = $origmail;
1.618     raeburn  14238:         }
1.1075.2.139! raeburn  14239:         if ($mailing eq 'helpdeskmail') {
        !          14240:             if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
        !          14241:                 (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
        !          14242:                 my ($inststatus,$inststatus_checked);
        !          14243:                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
        !          14244:                     ($env{'user.domain'} ne 'public')) {
        !          14245:                     $inststatus_checked = 1;
        !          14246:                     $inststatus = $env{'environment.inststatus'};
        !          14247:                 }
        !          14248:                 unless ($inststatus_checked) {
        !          14249:                     if (($requname ne '') && ($requdom ne '')) {
        !          14250:                         if (($requname =~ /^$match_username$/) &&
        !          14251:                             ($requdom =~ /^$match_domain$/) &&
        !          14252:                             (&Apache::lonnet::domain($requdom))) {
        !          14253:                             my $requhome = &Apache::lonnet::homeserver($requname,
        !          14254:                                                                       $requdom);
        !          14255:                             unless ($requhome eq 'no_host') {
        !          14256:                                 my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
        !          14257:                                 $inststatus = $userenv{'inststatus'};
        !          14258:                                 $inststatus_checked = 1;
        !          14259:                             }
        !          14260:                         }
        !          14261:                     }
        !          14262:                 }
        !          14263:                 unless ($inststatus_checked) {
        !          14264:                     if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
        !          14265:                         my %srch = (srchby     => 'email',
        !          14266:                                     srchdomain => $defdom,
        !          14267:                                     srchterm   => $reqemail,
        !          14268:                                     srchtype   => 'exact');
        !          14269:                         my %srch_results = &Apache::lonnet::usersearch(\%srch);
        !          14270:                         foreach my $uname (keys(%srch_results)) {
        !          14271:                             if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
        !          14272:                                 $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
        !          14273:                                 $inststatus_checked = 1;
        !          14274:                                 last;
        !          14275:                             }
        !          14276:                         }
        !          14277:                         unless ($inststatus_checked) {
        !          14278:                             my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
        !          14279:                             if ($dirsrchres eq 'ok') {
        !          14280:                                 foreach my $uname (keys(%srch_results)) {
        !          14281:                                     if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
        !          14282:                                         $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
        !          14283:                                         $inststatus_checked = 1;
        !          14284:                                         last;
        !          14285:                                     }
        !          14286:                                 }
        !          14287:                             }
        !          14288:                         }
        !          14289:                     }
        !          14290:                 }
        !          14291:                 if ($inststatus ne '') {
        !          14292:                     foreach my $status (split(/\:/,$inststatus)) {
        !          14293:                         if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
        !          14294:                             my @contacts = ('adminemail','supportemail');
        !          14295:                             foreach my $item (@contacts) {
        !          14296:                                 if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
        !          14297:                                     my $addr = $domconfig{'contacts'}{'overrides'}{$status};
        !          14298:                                     if (!grep(/^\Q$addr\E$/,@recipients)) {
        !          14299:                                         push(@recipients,$addr);
        !          14300:                                     }
        !          14301:                                 }
        !          14302:                             }
        !          14303:                             $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
        !          14304:                             if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
        !          14305:                                 my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
        !          14306:                                 my @ok_bccs;
        !          14307:                                 foreach my $bcc (@bccs) {
        !          14308:                                     $bcc =~ s/^\s+//g;
        !          14309:                                     $bcc =~ s/\s+$//g;
        !          14310:                                     if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
        !          14311:                                         if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
        !          14312:                                             push(@ok_bccs,$bcc);
        !          14313:                                         }
        !          14314:                                     }
        !          14315:                                 }
        !          14316:                                 if (@ok_bccs > 0) {
        !          14317:                                     $allbcc = join(', ',@ok_bccs);
        !          14318:                                 }
        !          14319:                             }
        !          14320:                             $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
        !          14321:                             last;
        !          14322:                         }
        !          14323:                     }
        !          14324:                 }
        !          14325:             }
        !          14326:         }
1.619     raeburn  14327:     } elsif ($origmail ne '') {
1.1075.2.122  raeburn  14328:         $lastresort = $origmail;
                   14329:     }
1.1075.2.128  raeburn  14330:     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1075.2.122  raeburn  14331:         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
                   14332:             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   14333:             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
                   14334:             my %what = (
                   14335:                           perlvar => 1,
                   14336:                        );
                   14337:             my $primary = &Apache::lonnet::domain($defdom,'primary');
                   14338:             if ($primary) {
                   14339:                 my $gotaddr;
                   14340:                 my ($result,$returnhash) =
                   14341:                     &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   14342:                 if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                   14343:                     if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                   14344:                         $lastresort = $returnhash->{'lonSupportEMail'};
                   14345:                         $gotaddr = 1;
                   14346:                     }
                   14347:                 }
                   14348:                 unless ($gotaddr) {
                   14349:                     my $uintdom = &Apache::lonnet::internet_dom($primary);
                   14350:                     my $intdom = &Apache::lonnet::internet_dom($lonhost);
                   14351:                     unless ($uintdom eq $intdom) {
                   14352:                         my %domconfig =
                   14353:                             &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                   14354:                         if (ref($domconfig{'contacts'}) eq 'HASH') {
                   14355:                             if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                   14356:                                 my @contacts = ('adminemail','supportemail');
                   14357:                                 foreach my $item (@contacts) {
                   14358:                                     if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                   14359:                                         my $addr = $domconfig{'contacts'}{$item};
                   14360:                                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14361:                                             push(@recipients,$addr);
                   14362:                                         }
                   14363:                                     }
                   14364:                                 }
                   14365:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                   14366:                                     $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                   14367:                                 }
                   14368:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                   14369:                                     my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                   14370:                                     my @ok_bccs;
                   14371:                                     foreach my $bcc (@bccs) {
                   14372:                                         $bcc =~ s/^\s+//g;
                   14373:                                         $bcc =~ s/\s+$//g;
                   14374:                                         if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   14375:                                             if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   14376:                                                 push(@ok_bccs,$bcc);
                   14377:                                             }
                   14378:                                         }
                   14379:                                     }
                   14380:                                     if (@ok_bccs > 0) {
                   14381:                                         $allbcc = join(', ',@ok_bccs);
                   14382:                                     }
                   14383:                                 }
                   14384:                                 $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                   14385:                             }
                   14386:                         }
                   14387:                     }
                   14388:                 }
                   14389:             }
                   14390:         }
1.618     raeburn  14391:     }
1.688     raeburn  14392:     if (defined($defmail)) {
                   14393:         if ($defmail ne '') {
                   14394:             push(@recipients,$defmail);
                   14395:         }
1.618     raeburn  14396:     }
                   14397:     if ($otheremails) {
1.619     raeburn  14398:         my @others;
                   14399:         if ($otheremails =~ /,/) {
                   14400:             @others = split(/,/,$otheremails);
1.618     raeburn  14401:         } else {
1.619     raeburn  14402:             push(@others,$otheremails);
                   14403:         }
                   14404:         foreach my $addr (@others) {
                   14405:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14406:                 push(@recipients,$addr);
                   14407:             }
1.618     raeburn  14408:         }
                   14409:     }
1.1075.2.128  raeburn  14410:     if ($mailing eq 'helpdeskmail') {
1.1075.2.122  raeburn  14411:         if ((!@recipients) && ($lastresort ne '')) {
                   14412:             push(@recipients,$lastresort);
                   14413:         }
                   14414:     } elsif ($lastresort ne '') {
                   14415:         if (!grep(/^\Q$lastresort\E$/,@recipients)) {
                   14416:             push(@recipients,$lastresort);
                   14417:         }
                   14418:     }
                   14419:     my $recipientlist = join(',',@recipients);
                   14420:     if (wantarray) {
                   14421:         return ($recipientlist,$allbcc,$addtext);
                   14422:     } else {
                   14423:         return $recipientlist;
                   14424:     }
1.618     raeburn  14425: }
                   14426: 
1.127     matthew  14427: ############################################################
                   14428: ############################################################
1.154     albertel 14429: 
1.655     raeburn  14430: =pod
                   14431: 
                   14432: =head1 Course Catalog Routines
                   14433: 
                   14434: =over 4
                   14435: 
                   14436: =item * &gather_categories()
                   14437: 
                   14438: Converts category definitions - keys of categories hash stored in  
                   14439: coursecategories in configuration.db on the primary library server in a 
                   14440: domain - to an array.  Also generates javascript and idx hash used to 
                   14441: generate Domain Coordinator interface for editing Course Categories.
                   14442: 
                   14443: Inputs:
1.663     raeburn  14444: 
1.655     raeburn  14445: categories (reference to hash of category definitions).
1.663     raeburn  14446: 
1.655     raeburn  14447: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14448:       categories and subcategories).
1.663     raeburn  14449: 
1.655     raeburn  14450: idx (reference to hash of counters used in Domain Coordinator interface for 
                   14451:       editing Course Categories).
1.663     raeburn  14452: 
1.655     raeburn  14453: jsarray (reference to array of categories used to create Javascript arrays for
                   14454:          Domain Coordinator interface for editing Course Categories).
                   14455: 
                   14456: Returns: nothing
                   14457: 
                   14458: Side effects: populates cats, idx and jsarray. 
                   14459: 
                   14460: =cut
                   14461: 
                   14462: sub gather_categories {
                   14463:     my ($categories,$cats,$idx,$jsarray) = @_;
                   14464:     my %counters;
                   14465:     my $num = 0;
                   14466:     foreach my $item (keys(%{$categories})) {
                   14467:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   14468:         if ($container eq '' && $depth == 0) {
                   14469:             $cats->[$depth][$categories->{$item}] = $cat;
                   14470:         } else {
                   14471:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   14472:         }
                   14473:         my ($escitem,$tail) = split(/:/,$item,2);
                   14474:         if ($counters{$tail} eq '') {
                   14475:             $counters{$tail} = $num;
                   14476:             $num ++;
                   14477:         }
                   14478:         if (ref($idx) eq 'HASH') {
                   14479:             $idx->{$item} = $counters{$tail};
                   14480:         }
                   14481:         if (ref($jsarray) eq 'ARRAY') {
                   14482:             push(@{$jsarray->[$counters{$tail}]},$item);
                   14483:         }
                   14484:     }
                   14485:     return;
                   14486: }
                   14487: 
                   14488: =pod
                   14489: 
                   14490: =item * &extract_categories()
                   14491: 
                   14492: Used to generate breadcrumb trails for course categories.
                   14493: 
                   14494: Inputs:
1.663     raeburn  14495: 
1.655     raeburn  14496: categories (reference to hash of category definitions).
1.663     raeburn  14497: 
1.655     raeburn  14498: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14499:       categories and subcategories).
1.663     raeburn  14500: 
1.655     raeburn  14501: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  14502: 
1.655     raeburn  14503: allitems (reference to hash - key is category key 
                   14504:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14505: 
1.655     raeburn  14506: idx (reference to hash of counters used in Domain Coordinator interface for
                   14507:       editing Course Categories).
1.663     raeburn  14508: 
1.655     raeburn  14509: jsarray (reference to array of categories used to create Javascript arrays for
                   14510:          Domain Coordinator interface for editing Course Categories).
                   14511: 
1.665     raeburn  14512: subcats (reference to hash of arrays containing all subcategories within each 
                   14513:          category, -recursive)
                   14514: 
1.1075.2.132  raeburn  14515: maxd (reference to hash used to hold max depth for all top-level categories).
                   14516: 
1.655     raeburn  14517: Returns: nothing
                   14518: 
                   14519: Side effects: populates trails and allitems hash references.
                   14520: 
                   14521: =cut
                   14522: 
                   14523: sub extract_categories {
1.1075.2.132  raeburn  14524:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655     raeburn  14525:     if (ref($categories) eq 'HASH') {
                   14526:         &gather_categories($categories,$cats,$idx,$jsarray);
                   14527:         if (ref($cats->[0]) eq 'ARRAY') {
                   14528:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   14529:                 my $name = $cats->[0][$i];
                   14530:                 my $item = &escape($name).'::0';
                   14531:                 my $trailstr;
                   14532:                 if ($name eq 'instcode') {
                   14533:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  14534:                 } elsif ($name eq 'communities') {
                   14535:                     $trailstr = &mt('Communities');
1.655     raeburn  14536:                 } else {
                   14537:                     $trailstr = $name;
                   14538:                 }
                   14539:                 if ($allitems->{$item} eq '') {
                   14540:                     push(@{$trails},$trailstr);
                   14541:                     $allitems->{$item} = scalar(@{$trails})-1;
                   14542:                 }
                   14543:                 my @parents = ($name);
                   14544:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   14545:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   14546:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  14547:                         if (ref($subcats) eq 'HASH') {
                   14548:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   14549:                         }
1.1075.2.132  raeburn  14550:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665     raeburn  14551:                     }
                   14552:                 } else {
                   14553:                     if (ref($subcats) eq 'HASH') {
                   14554:                         $subcats->{$item} = [];
1.655     raeburn  14555:                     }
1.1075.2.132  raeburn  14556:                     if (ref($maxd) eq 'HASH') {
                   14557:                         $maxd->{$name} = 1;
                   14558:                     }
1.655     raeburn  14559:                 }
                   14560:             }
                   14561:         }
                   14562:     }
                   14563:     return;
                   14564: }
                   14565: 
                   14566: =pod
                   14567: 
1.1075.2.56  raeburn  14568: =item * &recurse_categories()
1.655     raeburn  14569: 
                   14570: Recursively used to generate breadcrumb trails for course categories.
                   14571: 
                   14572: Inputs:
1.663     raeburn  14573: 
1.655     raeburn  14574: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14575:       categories and subcategories).
1.663     raeburn  14576: 
1.655     raeburn  14577: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  14578: 
                   14579: category (current course category, for which breadcrumb trail is being generated).
                   14580: 
                   14581: trails (reference to array of breadcrumb trails for each category).
                   14582: 
1.655     raeburn  14583: allitems (reference to hash - key is category key
                   14584:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14585: 
1.655     raeburn  14586: parents (array containing containers directories for current category, 
                   14587:          back to top level). 
                   14588: 
                   14589: Returns: nothing
                   14590: 
                   14591: Side effects: populates trails and allitems hash references
                   14592: 
                   14593: =cut
                   14594: 
                   14595: sub recurse_categories {
1.1075.2.132  raeburn  14596:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655     raeburn  14597:     my $shallower = $depth - 1;
                   14598:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   14599:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   14600:             my $name = $cats->[$depth]{$category}[$k];
                   14601:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14602:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14603:             if ($allitems->{$item} eq '') {
                   14604:                 push(@{$trails},$trailstr);
                   14605:                 $allitems->{$item} = scalar(@{$trails})-1;
                   14606:             }
                   14607:             my $deeper = $depth+1;
                   14608:             push(@{$parents},$category);
1.665     raeburn  14609:             if (ref($subcats) eq 'HASH') {
                   14610:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   14611:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   14612:                     my $higher;
                   14613:                     if ($j > 0) {
                   14614:                         $higher = &escape($parents->[$j]).':'.
                   14615:                                   &escape($parents->[$j-1]).':'.$j;
                   14616:                     } else {
                   14617:                         $higher = &escape($parents->[$j]).'::'.$j;
                   14618:                     }
                   14619:                     push(@{$subcats->{$higher}},$subcat);
                   14620:                 }
                   14621:             }
                   14622:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1075.2.132  raeburn  14623:                                 $subcats,$maxd);
1.655     raeburn  14624:             pop(@{$parents});
                   14625:         }
                   14626:     } else {
                   14627:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.132  raeburn  14628:         my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  14629:         if ($allitems->{$item} eq '') {
                   14630:             push(@{$trails},$trailstr);
                   14631:             $allitems->{$item} = scalar(@{$trails})-1;
                   14632:         }
1.1075.2.132  raeburn  14633:         if (ref($maxd) eq 'HASH') {
                   14634:             if ($depth > $maxd->{$parents->[0]}) {
                   14635:                 $maxd->{$parents->[0]} = $depth;
                   14636:             }
                   14637:         }
1.655     raeburn  14638:     }
                   14639:     return;
                   14640: }
                   14641: 
1.663     raeburn  14642: =pod
                   14643: 
1.1075.2.56  raeburn  14644: =item * &assign_categories_table()
1.663     raeburn  14645: 
                   14646: Create a datatable for display of hierarchical categories in a domain,
                   14647: with checkboxes to allow a course to be categorized. 
                   14648: 
                   14649: Inputs:
                   14650: 
                   14651: cathash - reference to hash of categories defined for the domain (from
                   14652:           configuration.db)
                   14653: 
                   14654: currcat - scalar with an & separated list of categories assigned to a course. 
                   14655: 
1.919     raeburn  14656: type    - scalar contains course type (Course or Community).
                   14657: 
1.1075.2.117  raeburn  14658: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   14659:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   14660: 
1.663     raeburn  14661: Returns: $output (markup to be displayed) 
                   14662: 
                   14663: =cut
                   14664: 
                   14665: sub assign_categories_table {
1.1075.2.117  raeburn  14666:     my ($cathash,$currcat,$type,$disabled) = @_;
1.663     raeburn  14667:     my $output;
                   14668:     if (ref($cathash) eq 'HASH') {
1.1075.2.132  raeburn  14669:         my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
                   14670:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663     raeburn  14671:         $maxdepth = scalar(@cats);
                   14672:         if (@cats > 0) {
                   14673:             my $itemcount = 0;
                   14674:             if (ref($cats[0]) eq 'ARRAY') {
                   14675:                 my @currcategories;
                   14676:                 if ($currcat ne '') {
                   14677:                     @currcategories = split('&',$currcat);
                   14678:                 }
1.919     raeburn  14679:                 my $table;
1.663     raeburn  14680:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   14681:                     my $parent = $cats[0][$i];
1.919     raeburn  14682:                     next if ($parent eq 'instcode');
                   14683:                     if ($type eq 'Community') {
                   14684:                         next unless ($parent eq 'communities');
                   14685:                     } else {
                   14686:                         next if ($parent eq 'communities');
                   14687:                     }
1.663     raeburn  14688:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   14689:                     my $item = &escape($parent).'::0';
                   14690:                     my $checked = '';
                   14691:                     if (@currcategories > 0) {
                   14692:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   14693:                             $checked = ' checked="checked"';
1.663     raeburn  14694:                         }
                   14695:                     }
1.919     raeburn  14696:                     my $parent_title = $parent;
                   14697:                     if ($parent eq 'communities') {
                   14698:                         $parent_title = &mt('Communities');
                   14699:                     }
                   14700:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   14701:                               '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117  raeburn  14702:                               $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919     raeburn  14703:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  14704:                     my $depth = 1;
                   14705:                     push(@path,$parent);
1.1075.2.117  raeburn  14706:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663     raeburn  14707:                     pop(@path);
1.919     raeburn  14708:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  14709:                     $itemcount ++;
                   14710:                 }
1.919     raeburn  14711:                 if ($itemcount) {
                   14712:                     $output = &Apache::loncommon::start_data_table().
                   14713:                               $table.
                   14714:                               &Apache::loncommon::end_data_table();
                   14715:                 }
1.663     raeburn  14716:             }
                   14717:         }
                   14718:     }
                   14719:     return $output;
                   14720: }
                   14721: 
                   14722: =pod
                   14723: 
1.1075.2.56  raeburn  14724: =item * &assign_category_rows()
1.663     raeburn  14725: 
                   14726: Create a datatable row for display of nested categories in a domain,
                   14727: with checkboxes to allow a course to be categorized,called recursively.
                   14728: 
                   14729: Inputs:
                   14730: 
                   14731: itemcount - track row number for alternating colors
                   14732: 
                   14733: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   14734:       categories and subcategories.
                   14735: 
                   14736: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   14737: 
                   14738: parent - parent of current category item
                   14739: 
                   14740: path - Array containing all categories back up through the hierarchy from the
                   14741:        current category to the top level.
                   14742: 
                   14743: currcategories - reference to array of current categories assigned to the course
                   14744: 
1.1075.2.117  raeburn  14745: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   14746:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   14747: 
1.663     raeburn  14748: Returns: $output (markup to be displayed).
                   14749: 
                   14750: =cut
                   14751: 
                   14752: sub assign_category_rows {
1.1075.2.117  raeburn  14753:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663     raeburn  14754:     my ($text,$name,$item,$chgstr);
                   14755:     if (ref($cats) eq 'ARRAY') {
                   14756:         my $maxdepth = scalar(@{$cats});
                   14757:         if (ref($cats->[$depth]) eq 'HASH') {
                   14758:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   14759:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   14760:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  14761:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  14762:                 for (my $j=0; $j<$numchildren; $j++) {
                   14763:                     $name = $cats->[$depth]{$parent}[$j];
                   14764:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   14765:                     my $deeper = $depth+1;
                   14766:                     my $checked = '';
                   14767:                     if (ref($currcategories) eq 'ARRAY') {
                   14768:                         if (@{$currcategories} > 0) {
                   14769:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   14770:                                 $checked = ' checked="checked"';
1.663     raeburn  14771:                             }
                   14772:                         }
                   14773:                     }
1.664     raeburn  14774:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   14775:                              '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117  raeburn  14776:                              $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675     raeburn  14777:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   14778:                              '</td><td>';
1.663     raeburn  14779:                     if (ref($path) eq 'ARRAY') {
                   14780:                         push(@{$path},$name);
1.1075.2.117  raeburn  14781:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663     raeburn  14782:                         pop(@{$path});
                   14783:                     }
                   14784:                     $text .= '</td></tr>';
                   14785:                 }
                   14786:                 $text .= '</table></td>';
                   14787:             }
                   14788:         }
                   14789:     }
                   14790:     return $text;
                   14791: }
                   14792: 
1.1075.2.69  raeburn  14793: =pod
                   14794: 
                   14795: =back
                   14796: 
                   14797: =cut
                   14798: 
1.655     raeburn  14799: ############################################################
                   14800: ############################################################
                   14801: 
                   14802: 
1.443     albertel 14803: sub commit_customrole {
1.664     raeburn  14804:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  14805:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 14806:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   14807:                          ($end?', ending '.localtime($end):'').': <b>'.
                   14808:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  14809:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 14810:                  '</b><br />';
                   14811:     return $output;
                   14812: }
                   14813: 
                   14814: sub commit_standardrole {
1.1075.2.31  raeburn  14815:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  14816:     my ($output,$logmsg,$linefeed);
                   14817:     if ($context eq 'auto') {
                   14818:         $linefeed = "\n";
                   14819:     } else {
                   14820:         $linefeed = "<br />\n";
                   14821:     }  
1.443     albertel 14822:     if ($three eq 'st') {
1.541     raeburn  14823:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  14824:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  14825:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  14826:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   14827:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 14828:         } else {
1.541     raeburn  14829:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 14830:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14831:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   14832:             if ($context eq 'auto') {
                   14833:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   14834:             } else {
                   14835:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   14836:                &mt('Add to classlist').': <b>ok</b>';
                   14837:             }
                   14838:             $output .= $linefeed;
1.443     albertel 14839:         }
                   14840:     } else {
                   14841:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   14842:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14843:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  14844:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  14845:         if ($context eq 'auto') {
                   14846:             $output .= $result.$linefeed;
                   14847:         } else {
                   14848:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   14849:         }
1.443     albertel 14850:     }
                   14851:     return $output;
                   14852: }
                   14853: 
                   14854: sub commit_studentrole {
1.1075.2.31  raeburn  14855:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   14856:         $credits) = @_;
1.626     raeburn  14857:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  14858:     if ($context eq 'auto') {
                   14859:         $linefeed = "\n";
                   14860:     } else {
                   14861:         $linefeed = '<br />'."\n";
                   14862:     }
1.443     albertel 14863:     if (defined($one) && defined($two)) {
                   14864:         my $cid=$one.'_'.$two;
                   14865:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   14866:         my $secchange = 0;
                   14867:         my $expire_role_result;
                   14868:         my $modify_section_result;
1.628     raeburn  14869:         if ($oldsec ne '-1') { 
                   14870:             if ($oldsec ne $sec) {
1.443     albertel 14871:                 $secchange = 1;
1.628     raeburn  14872:                 my $now = time;
1.443     albertel 14873:                 my $uurl='/'.$cid;
                   14874:                 $uurl=~s/\_/\//g;
                   14875:                 if ($oldsec) {
                   14876:                     $uurl.='/'.$oldsec;
                   14877:                 }
1.626     raeburn  14878:                 $oldsecurl = $uurl;
1.628     raeburn  14879:                 $expire_role_result = 
1.652     raeburn  14880:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  14881:                 if ($env{'request.course.sec'} ne '') { 
                   14882:                     if ($expire_role_result eq 'refused') {
                   14883:                         my @roles = ('st');
                   14884:                         my @statuses = ('previous');
                   14885:                         my @roledoms = ($one);
                   14886:                         my $withsec = 1;
                   14887:                         my %roleshash = 
                   14888:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   14889:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   14890:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   14891:                             my ($oldstart,$oldend) = 
                   14892:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   14893:                             if ($oldend > 0 && $oldend <= $now) {
                   14894:                                 $expire_role_result = 'ok';
                   14895:                             }
                   14896:                         }
                   14897:                     }
                   14898:                 }
1.443     albertel 14899:                 $result = $expire_role_result;
                   14900:             }
                   14901:         }
                   14902:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  14903:             $modify_section_result = 
                   14904:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   14905:                                                            undef,undef,undef,$sec,
                   14906:                                                            $end,$start,'','',$cid,
                   14907:                                                            '',$context,$credits);
1.443     albertel 14908:             if ($modify_section_result =~ /^ok/) {
                   14909:                 if ($secchange == 1) {
1.628     raeburn  14910:                     if ($sec eq '') {
                   14911:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   14912:                     } else {
                   14913:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   14914:                     }
1.443     albertel 14915:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  14916:                     if ($sec eq '') {
                   14917:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   14918:                     } else {
                   14919:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14920:                     }
1.443     albertel 14921:                 } else {
1.628     raeburn  14922:                     if ($sec eq '') {
                   14923:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   14924:                     } else {
                   14925:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14926:                     }
1.443     albertel 14927:                 }
                   14928:             } else {
1.628     raeburn  14929:                 if ($secchange) {       
                   14930:                     $$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;
                   14931:                 } else {
                   14932:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   14933:                 }
1.443     albertel 14934:             }
                   14935:             $result = $modify_section_result;
                   14936:         } elsif ($secchange == 1) {
1.628     raeburn  14937:             if ($oldsec eq '') {
1.1075.2.20  raeburn  14938:                 $$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  14939:             } else {
                   14940:                 $$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;
                   14941:             }
1.626     raeburn  14942:             if ($expire_role_result eq 'refused') {
                   14943:                 my $newsecurl = '/'.$cid;
                   14944:                 $newsecurl =~ s/\_/\//g;
                   14945:                 if ($sec ne '') {
                   14946:                     $newsecurl.='/'.$sec;
                   14947:                 }
                   14948:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   14949:                     if ($sec eq '') {
                   14950:                         $$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;
                   14951:                     } else {
                   14952:                         $$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;
                   14953:                     }
                   14954:                 }
                   14955:             }
1.443     albertel 14956:         }
                   14957:     } else {
1.626     raeburn  14958:         $$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 14959:         $result = "error: incomplete course id\n";
                   14960:     }
                   14961:     return $result;
                   14962: }
                   14963: 
1.1075.2.25  raeburn  14964: sub show_role_extent {
                   14965:     my ($scope,$context,$role) = @_;
                   14966:     $scope =~ s{^/}{};
                   14967:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   14968:     push(@courseroles,'co');
                   14969:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   14970:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   14971:         $scope =~ s{/}{_};
                   14972:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   14973:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   14974:         my ($audom,$auname) = split(/\//,$scope);
                   14975:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   14976:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   14977:     } else {
                   14978:         $scope =~ s{/$}{};
                   14979:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   14980:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   14981:     }
                   14982: }
                   14983: 
1.443     albertel 14984: ############################################################
                   14985: ############################################################
                   14986: 
1.566     albertel 14987: sub check_clone {
1.578     raeburn  14988:     my ($args,$linefeed) = @_;
1.566     albertel 14989:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   14990:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   14991:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   14992:     my $clonemsg;
                   14993:     my $can_clone = 0;
1.944     raeburn  14994:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  14995:     if ($lctype ne 'community') {
                   14996:         $lctype = 'course';
                   14997:     }
1.566     albertel 14998:     if ($clonehome eq 'no_host') {
1.944     raeburn  14999:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  15000:             $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'});
                   15001:         } else {
                   15002:             $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'});
                   15003:         }     
1.566     albertel 15004:     } else {
                   15005: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  15006:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  15007:             if ($clonedesc{'type'} ne 'Community') {
                   15008:                  $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'});
                   15009:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15010:             }
                   15011:         }
1.1075.2.119  raeburn  15012: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882     raeburn  15013:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 15014: 	    $can_clone = 1;
                   15015: 	} else {
1.1075.2.95  raeburn  15016: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 15017: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95  raeburn  15018:             if ($clonehash{'cloners'} eq '') {
                   15019:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   15020:                 if ($domdefs{'canclone'}) {
                   15021:                     unless ($domdefs{'canclone'} eq 'none') {
                   15022:                         if ($domdefs{'canclone'} eq 'domain') {
                   15023:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   15024:                                 $can_clone = 1;
                   15025:                             }
                   15026:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   15027:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   15028:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   15029:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   15030:                                 $can_clone = 1;
                   15031:                             }
                   15032:                         }
                   15033:                     }
1.908     raeburn  15034:                 }
1.1075.2.95  raeburn  15035:             } else {
                   15036: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   15037:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  15038:                     $can_clone = 1;
1.1075.2.95  raeburn  15039:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  15040:                     $can_clone = 1;
1.1075.2.96  raeburn  15041:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   15042:                     $can_clone = 1;
1.1075.2.95  raeburn  15043:                 }
                   15044:                 unless ($can_clone) {
1.1075.2.96  raeburn  15045:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   15046:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1075.2.95  raeburn  15047:                         my (%gotdomdefaults,%gotcodedefaults);
                   15048:                         foreach my $cloner (@cloners) {
                   15049:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   15050:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   15051:                                 my (%codedefaults,@code_order);
                   15052:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   15053:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   15054:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   15055:                                     }
                   15056:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   15057:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   15058:                                     }
                   15059:                                 } else {
                   15060:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   15061:                                                                             \%codedefaults,
                   15062:                                                                             \@code_order);
                   15063:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   15064:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   15065:                                 }
                   15066:                                 if (@code_order > 0) {
                   15067:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   15068:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   15069:                                                                                 $args->{'crscode'})) {
                   15070:                                         $can_clone = 1;
                   15071:                                         last;
                   15072:                                     }
                   15073:                                 }
                   15074:                             }
                   15075:                         }
                   15076:                     }
1.1075.2.96  raeburn  15077:                 }
                   15078:             }
                   15079:             unless ($can_clone) {
                   15080:                 my $ccrole = 'cc';
                   15081:                 if ($args->{'crstype'} eq 'Community') {
                   15082:                     $ccrole = 'co';
                   15083:                 }
                   15084:                 my %roleshash =
                   15085:                     &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   15086:                                                   $args->{'ccdomain'},
                   15087:                                                   'userroles',['active'],[$ccrole],
                   15088:                                                   [$args->{'clonedomain'}]);
                   15089:                 if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   15090:                     $can_clone = 1;
                   15091:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   15092:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   15093:                     $can_clone = 1;
1.1075.2.95  raeburn  15094:                 }
                   15095:             }
                   15096:             unless ($can_clone) {
                   15097:                 if ($args->{'crstype'} eq 'Community') {
                   15098:                     $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'});
                   15099:                 } else {
                   15100:                     $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'});
1.578     raeburn  15101: 	        }
1.566     albertel 15102: 	    }
1.578     raeburn  15103:         }
1.566     albertel 15104:     }
                   15105:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15106: }
                   15107: 
1.444     albertel 15108: sub construct_course {
1.1075.2.119  raeburn  15109:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
                   15110:         $cnum,$category,$coderef) = @_;
1.444     albertel 15111:     my $outcome;
1.541     raeburn  15112:     my $linefeed =  '<br />'."\n";
                   15113:     if ($context eq 'auto') {
                   15114:         $linefeed = "\n";
                   15115:     }
1.566     albertel 15116: 
                   15117: #
                   15118: # Are we cloning?
                   15119: #
                   15120:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15121:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  15122: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 15123: 	if ($context ne 'auto') {
1.578     raeburn  15124:             if ($clonemsg ne '') {
                   15125: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   15126:             }
1.566     albertel 15127: 	}
                   15128: 	$outcome .= $clonemsg.$linefeed;
                   15129: 
                   15130:         if (!$can_clone) {
                   15131: 	    return (0,$outcome);
                   15132: 	}
                   15133:     }
                   15134: 
1.444     albertel 15135: #
                   15136: # Open course
                   15137: #
                   15138:     my $crstype = lc($args->{'crstype'});
                   15139:     my %cenv=();
                   15140:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   15141:                                              $args->{'cdescr'},
                   15142:                                              $args->{'curl'},
                   15143:                                              $args->{'course_home'},
                   15144:                                              $args->{'nonstandard'},
                   15145:                                              $args->{'crscode'},
                   15146:                                              $args->{'ccuname'}.':'.
                   15147:                                              $args->{'ccdomain'},
1.882     raeburn  15148:                                              $args->{'crstype'},
1.885     raeburn  15149:                                              $cnum,$context,$category);
1.444     albertel 15150: 
                   15151:     # Note: The testing routines depend on this being output; see 
                   15152:     # Utils::Course. This needs to at least be output as a comment
                   15153:     # if anyone ever decides to not show this, and Utils::Course::new
                   15154:     # will need to be suitably modified.
1.541     raeburn  15155:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  15156:     if ($$courseid =~ /^error:/) {
                   15157:         return (0,$outcome);
                   15158:     }
                   15159: 
1.444     albertel 15160: #
                   15161: # Check if created correctly
                   15162: #
1.479     albertel 15163:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 15164:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  15165:     if ($crsuhome eq 'no_host') {
                   15166:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   15167:         return (0,$outcome);
                   15168:     }
1.541     raeburn  15169:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 15170: 
1.444     albertel 15171: #
1.566     albertel 15172: # Do the cloning
                   15173: #   
                   15174:     if ($can_clone && $cloneid) {
                   15175: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   15176: 	if ($context ne 'auto') {
                   15177: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   15178: 	}
                   15179: 	$outcome .= $clonemsg.$linefeed;
                   15180: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 15181: # Copy all files
1.637     www      15182: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 15183: # Restore URL
1.566     albertel 15184: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 15185: # Restore title
1.566     albertel 15186: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  15187: # Restore creation date, creator and creation context.
                   15188:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   15189:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   15190:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 15191: # Mark as cloned
1.566     albertel 15192: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      15193: # Need to clone grading mode
                   15194:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   15195:         $cenv{'grading'}=$newenv{'grading'};
                   15196: # Do not clone these environment entries
                   15197:         &Apache::lonnet::del('environment',
                   15198:                   ['default_enrollment_start_date',
                   15199:                    'default_enrollment_end_date',
                   15200:                    'question.email',
                   15201:                    'policy.email',
                   15202:                    'comment.email',
                   15203:                    'pch.users.denied',
1.725     raeburn  15204:                    'plc.users.denied',
                   15205:                    'hidefromcat',
1.1075.2.36  raeburn  15206:                    'checkforpriv',
1.1075.2.59  raeburn  15207:                    'categories',
                   15208:                    'internal.uniquecode'],
1.638     www      15209:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  15210:         if ($args->{'textbook'}) {
                   15211:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   15212:         }
1.444     albertel 15213:     }
1.566     albertel 15214: 
1.444     albertel 15215: #
                   15216: # Set environment (will override cloned, if existing)
                   15217: #
                   15218:     my @sections = ();
                   15219:     my @xlists = ();
                   15220:     if ($args->{'crstype'}) {
                   15221:         $cenv{'type'}=$args->{'crstype'};
                   15222:     }
                   15223:     if ($args->{'crsid'}) {
                   15224:         $cenv{'courseid'}=$args->{'crsid'};
                   15225:     }
                   15226:     if ($args->{'crscode'}) {
                   15227:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   15228:     }
                   15229:     if ($args->{'crsquota'} ne '') {
                   15230:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   15231:     } else {
                   15232:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   15233:     }
                   15234:     if ($args->{'ccuname'}) {
                   15235:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   15236:                                         ':'.$args->{'ccdomain'};
                   15237:     } else {
                   15238:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   15239:     }
1.1075.2.31  raeburn  15240:     if ($args->{'defaultcredits'}) {
                   15241:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   15242:     }
1.444     albertel 15243:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   15244:     if ($args->{'crssections'}) {
                   15245:         $cenv{'internal.sectionnums'} = '';
                   15246:         if ($args->{'crssections'} =~ m/,/) {
                   15247:             @sections = split/,/,$args->{'crssections'};
                   15248:         } else {
                   15249:             $sections[0] = $args->{'crssections'};
                   15250:         }
                   15251:         if (@sections > 0) {
                   15252:             foreach my $item (@sections) {
                   15253:                 my ($sec,$gp) = split/:/,$item;
                   15254:                 my $class = $args->{'crscode'}.$sec;
                   15255:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   15256:                 $cenv{'internal.sectionnums'} .= $item.',';
                   15257:                 unless ($addcheck eq 'ok') {
1.1075.2.119  raeburn  15258:                     push(@badclasses,$class);
1.444     albertel 15259:                 }
                   15260:             }
                   15261:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   15262:         }
                   15263:     }
                   15264: # do not hide course coordinator from staff listing, 
                   15265: # even if privileged
                   15266:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  15267: # add course coordinator's domain to domains to check for privileged users
                   15268: # if different to course domain
                   15269:     if ($$crsudom ne $args->{'ccdomain'}) {
                   15270:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   15271:     }
1.444     albertel 15272: # add crosslistings
                   15273:     if ($args->{'crsxlist'}) {
                   15274:         $cenv{'internal.crosslistings'}='';
                   15275:         if ($args->{'crsxlist'} =~ m/,/) {
                   15276:             @xlists = split/,/,$args->{'crsxlist'};
                   15277:         } else {
                   15278:             $xlists[0] = $args->{'crsxlist'};
                   15279:         }
                   15280:         if (@xlists > 0) {
                   15281:             foreach my $item (@xlists) {
                   15282:                 my ($xl,$gp) = split/:/,$item;
                   15283:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   15284:                 $cenv{'internal.crosslistings'} .= $item.',';
                   15285:                 unless ($addcheck eq 'ok') {
1.1075.2.119  raeburn  15286:                     push(@badclasses,$xl);
1.444     albertel 15287:                 }
                   15288:             }
                   15289:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   15290:         }
                   15291:     }
                   15292:     if ($args->{'autoadds'}) {
                   15293:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   15294:     }
                   15295:     if ($args->{'autodrops'}) {
                   15296:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   15297:     }
                   15298: # check for notification of enrollment changes
                   15299:     my @notified = ();
                   15300:     if ($args->{'notify_owner'}) {
                   15301:         if ($args->{'ccuname'} ne '') {
                   15302:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   15303:         }
                   15304:     }
                   15305:     if ($args->{'notify_dc'}) {
                   15306:         if ($uname ne '') { 
1.630     raeburn  15307:             push(@notified,$uname.':'.$udom);
1.444     albertel 15308:         }
                   15309:     }
                   15310:     if (@notified > 0) {
                   15311:         my $notifylist;
                   15312:         if (@notified > 1) {
                   15313:             $notifylist = join(',',@notified);
                   15314:         } else {
                   15315:             $notifylist = $notified[0];
                   15316:         }
                   15317:         $cenv{'internal.notifylist'} = $notifylist;
                   15318:     }
                   15319:     if (@badclasses > 0) {
                   15320:         my %lt=&Apache::lonlocal::texthash(
1.1075.2.119  raeburn  15321:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                   15322:                 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                   15323:                 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444     albertel 15324:         );
1.1075.2.119  raeburn  15325:         my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                   15326:                            &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
1.541     raeburn  15327:         if ($context eq 'auto') {
                   15328:             $outcome .= $badclass_msg.$linefeed;
1.1075.2.119  raeburn  15329:         } else {
1.566     albertel 15330:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1075.2.119  raeburn  15331:         }
                   15332:         foreach my $item (@badclasses) {
1.541     raeburn  15333:             if ($context eq 'auto') {
1.1075.2.119  raeburn  15334:                 $outcome .= " - $item\n";
1.541     raeburn  15335:             } else {
1.1075.2.119  raeburn  15336:                 $outcome .= "<li>$item</li>\n";
1.541     raeburn  15337:             }
1.1075.2.119  raeburn  15338:         }
                   15339:         if ($context eq 'auto') {
                   15340:             $outcome .= $linefeed;
                   15341:         } else {
                   15342:             $outcome .= "</ul><br /><br /></div>\n";
                   15343:         }
1.444     albertel 15344:     }
                   15345:     if ($args->{'no_end_date'}) {
                   15346:         $args->{'endaccess'} = 0;
                   15347:     }
                   15348:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   15349:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   15350:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   15351:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   15352:     if ($args->{'showphotos'}) {
                   15353:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   15354:     }
                   15355:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   15356:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   15357:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   15358:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  15359:             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'); 
                   15360:             if ($context eq 'auto') {
                   15361:                 $outcome .= $krb_msg;
                   15362:             } else {
1.566     albertel 15363:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  15364:             }
                   15365:             $outcome .= $linefeed;
1.444     albertel 15366:         }
                   15367:     }
                   15368:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   15369:        if ($args->{'setpolicy'}) {
                   15370:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15371:        }
                   15372:        if ($args->{'setcontent'}) {
                   15373:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15374:        }
1.1075.2.110  raeburn  15375:        if ($args->{'setcomment'}) {
                   15376:            $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15377:        }
1.444     albertel 15378:     }
                   15379:     if ($args->{'reshome'}) {
                   15380: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   15381: 	$cenv{'reshome'}=~s/\/+$/\//;
                   15382:     }
                   15383: #
                   15384: # course has keyed access
                   15385: #
                   15386:     if ($args->{'setkeys'}) {
                   15387:        $cenv{'keyaccess'}='yes';
                   15388:     }
                   15389: # if specified, key authority is not course, but user
                   15390: # only active if keyaccess is yes
                   15391:     if ($args->{'keyauth'}) {
1.487     albertel 15392: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   15393: 	$user = &LONCAPA::clean_username($user);
                   15394: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     15395: 	if ($user ne '' && $domain ne '') {
1.487     albertel 15396: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 15397: 	}
                   15398:     }
                   15399: 
1.1075.2.59  raeburn  15400: #
                   15401: #  generate and store uniquecode (available to course requester), if course should have one.
                   15402: #
                   15403:     if ($args->{'uniquecode'}) {
                   15404:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   15405:         if ($code) {
                   15406:             $cenv{'internal.uniquecode'} = $code;
                   15407:             my %crsinfo =
                   15408:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   15409:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   15410:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   15411:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   15412:             }
                   15413:             if (ref($coderef)) {
                   15414:                 $$coderef = $code;
                   15415:             }
                   15416:         }
                   15417:     }
                   15418: 
1.444     albertel 15419:     if ($args->{'disresdis'}) {
                   15420:         $cenv{'pch.roles.denied'}='st';
                   15421:     }
                   15422:     if ($args->{'disablechat'}) {
                   15423:         $cenv{'plc.roles.denied'}='st';
                   15424:     }
                   15425: 
                   15426:     # Record we've not yet viewed the Course Initialization Helper for this 
                   15427:     # course
                   15428:     $cenv{'course.helper.not.run'} = 1;
                   15429:     #
                   15430:     # Use new Randomseed
                   15431:     #
                   15432:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   15433:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   15434:     #
                   15435:     # The encryption code and receipt prefix for this course
                   15436:     #
                   15437:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   15438:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   15439:     #
                   15440:     # By default, use standard grading
                   15441:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   15442: 
1.541     raeburn  15443:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   15444:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15445: #
                   15446: # Open all assignments
                   15447: #
                   15448:     if ($args->{'openall'}) {
                   15449:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   15450:        my %storecontent = ($storeunder         => time,
                   15451:                            $storeunder.'.type' => 'date_start');
                   15452:        
                   15453:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  15454:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15455:    }
                   15456: #
                   15457: # Set first page
                   15458: #
                   15459:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   15460: 	    || ($cloneid)) {
1.445     albertel 15461: 	use LONCAPA::map;
1.444     albertel 15462: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 15463: 
                   15464: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   15465:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   15466: 
1.444     albertel 15467:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   15468:         my $title; my $url;
                   15469:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   15470: 	    $title=&mt('Syllabus');
1.444     albertel 15471:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   15472:         } else {
1.963     raeburn  15473:             $title=&mt('Table of Contents');
1.444     albertel 15474:             $url='/adm/navmaps';
                   15475:         }
1.445     albertel 15476: 
                   15477:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   15478: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   15479: 
                   15480: 	if ($errtext) { $fatal=2; }
1.541     raeburn  15481:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 15482:     }
1.566     albertel 15483: 
                   15484:     return (1,$outcome);
1.444     albertel 15485: }
                   15486: 
1.1075.2.59  raeburn  15487: sub make_unique_code {
                   15488:     my ($cdom,$cnum) = @_;
                   15489:     # get lock on uniquecodes db
                   15490:     my $lockhash = {
                   15491:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   15492:                                                   ':'.$env{'user.domain'},
                   15493:                    };
                   15494:     my $tries = 0;
                   15495:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15496:     my ($code,$error);
                   15497: 
                   15498:     while (($gotlock ne 'ok') && ($tries<3)) {
                   15499:         $tries ++;
                   15500:         sleep 1;
                   15501:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15502:     }
                   15503:     if ($gotlock eq 'ok') {
                   15504:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   15505:         my $gotcode;
                   15506:         my $attempts = 0;
                   15507:         while ((!$gotcode) && ($attempts < 100)) {
                   15508:             $code = &generate_code();
                   15509:             if (!exists($currcodes{$code})) {
                   15510:                 $gotcode = 1;
                   15511:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   15512:                     $error = 'nostore';
                   15513:                 }
                   15514:             }
                   15515:             $attempts ++;
                   15516:         }
                   15517:         my @del_lock = ($cnum."\0".'uniquecodes');
                   15518:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   15519:     } else {
                   15520:         $error = 'nolock';
                   15521:     }
                   15522:     return ($code,$error);
                   15523: }
                   15524: 
                   15525: sub generate_code {
                   15526:     my $code;
                   15527:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   15528:     for (my $i=0; $i<6; $i++) {
                   15529:         my $lettnum = int (rand 2);
                   15530:         my $item = '';
                   15531:         if ($lettnum) {
                   15532:             $item = $letts[int( rand(18) )];
                   15533:         } else {
                   15534:             $item = 1+int( rand(8) );
                   15535:         }
                   15536:         $code .= $item;
                   15537:     }
                   15538:     return $code;
                   15539: }
                   15540: 
1.444     albertel 15541: ############################################################
                   15542: ############################################################
                   15543: 
1.953     droeschl 15544: #SD
                   15545: # only Community and Course, or anything else?
1.378     raeburn  15546: sub course_type {
                   15547:     my ($cid) = @_;
                   15548:     if (!defined($cid)) {
                   15549:         $cid = $env{'request.course.id'};
                   15550:     }
1.404     albertel 15551:     if (defined($env{'course.'.$cid.'.type'})) {
                   15552:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  15553:     } else {
                   15554:         return 'Course';
1.377     raeburn  15555:     }
                   15556: }
1.156     albertel 15557: 
1.406     raeburn  15558: sub group_term {
                   15559:     my $crstype = &course_type();
                   15560:     my %names = (
                   15561:                   'Course' => 'group',
1.865     raeburn  15562:                   'Community' => 'group',
1.406     raeburn  15563:                 );
                   15564:     return $names{$crstype};
                   15565: }
                   15566: 
1.902     raeburn  15567: sub course_types {
1.1075.2.59  raeburn  15568:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  15569:     my %typename = (
                   15570:                          official   => 'Official course',
                   15571:                          unofficial => 'Unofficial course',
                   15572:                          community  => 'Community',
1.1075.2.59  raeburn  15573:                          textbook   => 'Textbook course',
1.902     raeburn  15574:                    );
                   15575:     return (\@types,\%typename);
                   15576: }
                   15577: 
1.156     albertel 15578: sub icon {
                   15579:     my ($file)=@_;
1.505     albertel 15580:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 15581:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 15582:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 15583:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   15584: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   15585: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15586: 	            $curfext.".gif") {
                   15587: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15588: 		$curfext.".gif";
                   15589: 	}
                   15590:     }
1.249     albertel 15591:     return &lonhttpdurl($iconname);
1.154     albertel 15592: } 
1.84      albertel 15593: 
1.575     albertel 15594: sub lonhttpdurl {
1.692     www      15595: #
                   15596: # Had been used for "small fry" static images on separate port 8080.
                   15597: # Modify here if lightweight http functionality desired again.
                   15598: # Currently eliminated due to increasing firewall issues.
                   15599: #
1.575     albertel 15600:     my ($url)=@_;
1.692     www      15601:     return $url;
1.215     albertel 15602: }
                   15603: 
1.213     albertel 15604: sub connection_aborted {
                   15605:     my ($r)=@_;
                   15606:     $r->print(" ");$r->rflush();
                   15607:     my $c = $r->connection;
                   15608:     return $c->aborted();
                   15609: }
                   15610: 
1.221     foxr     15611: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     15612: #    strings as 'strings'.
                   15613: sub escape_single {
1.221     foxr     15614:     my ($input) = @_;
1.223     albertel 15615:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     15616:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   15617:     return $input;
                   15618: }
1.223     albertel 15619: 
1.222     foxr     15620: #  Same as escape_single, but escape's "'s  This 
                   15621: #  can be used for  "strings"
                   15622: sub escape_double {
                   15623:     my ($input) = @_;
                   15624:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   15625:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   15626:     return $input;
                   15627: }
1.223     albertel 15628:  
1.222     foxr     15629: #   Escapes the last element of a full URL.
                   15630: sub escape_url {
                   15631:     my ($url)   = @_;
1.238     raeburn  15632:     my @urlslices = split(/\//, $url,-1);
1.369     www      15633:     my $lastitem = &escape(pop(@urlslices));
1.1075.2.83  raeburn  15634:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     15635: }
1.462     albertel 15636: 
1.820     raeburn  15637: sub compare_arrays {
                   15638:     my ($arrayref1,$arrayref2) = @_;
                   15639:     my (@difference,%count);
                   15640:     @difference = ();
                   15641:     %count = ();
                   15642:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   15643:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   15644:         foreach my $element (keys(%count)) {
                   15645:             if ($count{$element} == 1) {
                   15646:                 push(@difference,$element);
                   15647:             }
                   15648:         }
                   15649:     }
                   15650:     return @difference;
                   15651: }
                   15652: 
1.817     bisitz   15653: # -------------------------------------------------------- Initialize user login
1.462     albertel 15654: sub init_user_environment {
1.463     albertel 15655:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 15656:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   15657: 
                   15658:     my $public=($username eq 'public' && $domain eq 'public');
                   15659: 
                   15660: # See if old ID present, if so, remove
                   15661: 
1.1062    raeburn  15662:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 15663:     my $now=time;
                   15664: 
                   15665:     if ($public) {
                   15666: 	my $max_public=100;
                   15667: 	my $oldest;
                   15668: 	my $oldest_time=0;
                   15669: 	for(my $next=1;$next<=$max_public;$next++) {
                   15670: 	    if (-e $lonids."/publicuser_$next.id") {
                   15671: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   15672: 		if ($mtime<$oldest_time || !$oldest_time) {
                   15673: 		    $oldest_time=$mtime;
                   15674: 		    $oldest=$next;
                   15675: 		}
                   15676: 	    } else {
                   15677: 		$cookie="publicuser_$next";
                   15678: 		last;
                   15679: 	    }
                   15680: 	}
                   15681: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   15682:     } else {
1.463     albertel 15683: 	# if this isn't a robot, kill any existing non-robot sessions
                   15684: 	if (!$args->{'robot'}) {
                   15685: 	    opendir(DIR,$lonids);
                   15686: 	    while ($filename=readdir(DIR)) {
                   15687: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1075.2.136  raeburn  15688:                     if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
                   15689:                             &GDBM_READER(),0640)) {
                   15690:                         my $linkedfile;
                   15691:                         if (exists($oldenv{'user.linkedenv'})) {
                   15692:                             $linkedfile = $oldenv{'user.linkedenv'};
                   15693:                         }
                   15694:                         untie(%oldenv);
                   15695:                         if (unlink("$lonids/$filename")) {
                   15696:                             if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                   15697:                                 if (-l "$lonids/$linkedfile.id") {
                   15698:                                     unlink("$lonids/$linkedfile.id");
                   15699:                                 }
                   15700:                             }
                   15701:                         }
                   15702:                     } else {
                   15703:                         unlink($lonids.'/'.$filename);
                   15704:                     }
1.463     albertel 15705: 		}
1.462     albertel 15706: 	    }
1.463     albertel 15707: 	    closedir(DIR);
1.1075.2.84  raeburn  15708: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   15709:             my $namespace = 'nohist_courseeditor';
                   15710:             my $lockingkey = 'paste'."\0".'locked_num';
                   15711:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   15712:                                                 $domain,$username);
                   15713:             if (exists($lockhash{$lockingkey})) {
                   15714:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   15715:                 unless ($delresult eq 'ok') {
                   15716:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   15717:                 }
                   15718:             }
1.462     albertel 15719: 	}
                   15720: # Give them a new cookie
1.463     albertel 15721: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      15722: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 15723: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 15724:     
                   15725: # Initialize roles
                   15726: 
1.1062    raeburn  15727: 	($userroles,$firstaccenv,$timerintenv) = 
                   15728:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 15729:     }
                   15730: # ------------------------------------ Check browser type and MathML capability
                   15731: 
1.1075.2.77  raeburn  15732:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   15733:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 15734: 
                   15735: # ------------------------------------------------------------- Get environment
                   15736: 
                   15737:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   15738:     my ($tmp) = keys(%userenv);
                   15739:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   15740:     } else {
                   15741: 	undef(%userenv);
                   15742:     }
                   15743:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   15744: 	$form->{'interface'}=$userenv{'interface'};
                   15745:     }
                   15746:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   15747: 
                   15748: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   15749:     foreach my $option ('interface','localpath','localres') {
                   15750:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 15751:     }
                   15752: # --------------------------------------------------------- Write first profile
                   15753: 
                   15754:     {
                   15755: 	my %initial_env = 
                   15756: 	    ("user.name"          => $username,
                   15757: 	     "user.domain"        => $domain,
                   15758: 	     "user.home"          => $authhost,
                   15759: 	     "browser.type"       => $clientbrowser,
                   15760: 	     "browser.version"    => $clientversion,
                   15761: 	     "browser.mathml"     => $clientmathml,
                   15762: 	     "browser.unicode"    => $clientunicode,
                   15763: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  15764:              "browser.mobile"     => $clientmobile,
                   15765:              "browser.info"       => $clientinfo,
1.1075.2.77  raeburn  15766:              "browser.osversion"  => $clientosversion,
1.462     albertel 15767: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   15768: 	     "request.course.fn"  => '',
                   15769: 	     "request.course.uri" => '',
                   15770: 	     "request.course.sec" => '',
                   15771: 	     "request.role"       => 'cm',
                   15772: 	     "request.role.adv"   => $env{'user.adv'},
                   15773: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   15774: 
                   15775:         if ($form->{'localpath'}) {
                   15776: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   15777: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   15778:         }
                   15779: 	
                   15780: 	if ($form->{'interface'}) {
                   15781: 	    $form->{'interface'}=~s/\W//gs;
                   15782: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   15783: 	    $env{'browser.interface'}=$form->{'interface'};
                   15784: 	}
                   15785: 
1.1075.2.54  raeburn  15786:         if ($form->{'iptoken'}) {
                   15787:             my $lonhost = $r->dir_config('lonHostID');
                   15788:             $initial_env{"user.noloadbalance"} = $lonhost;
                   15789:             $env{'user.noloadbalance'} = $lonhost;
                   15790:         }
                   15791: 
1.1075.2.120  raeburn  15792:         if ($form->{'noloadbalance'}) {
                   15793:             my @hosts = &Apache::lonnet::current_machine_ids();
                   15794:             my $hosthere = $form->{'noloadbalance'};
                   15795:             if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   15796:                 $initial_env{"user.noloadbalance"} = $hosthere;
                   15797:                 $env{'user.noloadbalance'} = $hosthere;
                   15798:             }
                   15799:         }
                   15800: 
1.1016    raeburn  15801:         unless ($domain eq 'public') {
1.1075.2.125  raeburn  15802:             my %is_adv = ( is_adv => $env{'user.adv'} );
                   15803:             my %domdef = &Apache::lonnet::get_domain_defaults($domain);
1.980     raeburn  15804: 
1.1075.2.125  raeburn  15805:             foreach my $tool ('aboutme','blog','webdav','portfolio') {
                   15806:                 $userenv{'availabletools.'.$tool} = 
                   15807:                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   15808:                                                       undef,\%userenv,\%domdef,\%is_adv);
                   15809:             }
1.724     raeburn  15810: 
1.1075.2.125  raeburn  15811:             foreach my $crstype ('official','unofficial','community','textbook') {
                   15812:                 $userenv{'canrequest.'.$crstype} =
                   15813:                     &Apache::lonnet::usertools_access($username,$domain,$crstype,
                   15814:                                                       'reload','requestcourses',
                   15815:                                                       \%userenv,\%domdef,\%is_adv);
                   15816:             }
1.765     raeburn  15817: 
1.1075.2.125  raeburn  15818:             $userenv{'canrequest.author'} =
                   15819:                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   15820:                                                   'reload','requestauthor',
                   15821:                                                   \%userenv,\%domdef,\%is_adv);
                   15822:             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   15823:                                                  $domain,$username);
                   15824:             my $reqstatus = $reqauthor{'author_status'};
                   15825:             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   15826:                 if (ref($reqauthor{'author'}) eq 'HASH') {
                   15827:                     $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   15828:                                                       $reqauthor{'author'}{'timestamp'};
                   15829:                 }
1.1075.2.14  raeburn  15830:             }
                   15831:         }
                   15832: 
1.462     albertel 15833: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  15834: 
1.462     albertel 15835: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   15836: 		 &GDBM_WRCREAT(),0640)) {
                   15837: 	    &_add_to_env(\%disk_env,\%initial_env);
                   15838: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   15839: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  15840:             if (ref($firstaccenv) eq 'HASH') {
                   15841:                 &_add_to_env(\%disk_env,$firstaccenv);
                   15842:             }
                   15843:             if (ref($timerintenv) eq 'HASH') {
                   15844:                 &_add_to_env(\%disk_env,$timerintenv);
                   15845:             }
1.463     albertel 15846: 	    if (ref($args->{'extra_env'})) {
                   15847: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   15848: 	    }
1.462     albertel 15849: 	    untie(%disk_env);
                   15850: 	} else {
1.705     tempelho 15851: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   15852: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 15853: 	    return 'error: '.$!;
                   15854: 	}
                   15855:     }
                   15856:     $env{'request.role'}='cm';
                   15857:     $env{'request.role.adv'}=$env{'user.adv'};
                   15858:     $env{'browser.type'}=$clientbrowser;
                   15859: 
                   15860:     return $cookie;
                   15861: 
                   15862: }
                   15863: 
                   15864: sub _add_to_env {
                   15865:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  15866:     if (ref($env_data) eq 'HASH') {
                   15867:         while (my ($key,$value) = each(%$env_data)) {
                   15868: 	    $idf->{$prefix.$key} = $value;
                   15869: 	    $env{$prefix.$key}   = $value;
                   15870:         }
1.462     albertel 15871:     }
                   15872: }
                   15873: 
1.685     tempelho 15874: # --- Get the symbolic name of a problem and the url
                   15875: sub get_symb {
                   15876:     my ($request,$silent) = @_;
1.726     raeburn  15877:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 15878:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   15879:     if ($symb eq '') {
                   15880:         if (!$silent) {
1.1071    raeburn  15881:             if (ref($request)) { 
                   15882:                 $request->print("Unable to handle ambiguous references:$url:.");
                   15883:             }
1.685     tempelho 15884:             return ();
                   15885:         }
                   15886:     }
                   15887:     &Apache::lonenc::check_decrypt(\$symb);
                   15888:     return ($symb);
                   15889: }
                   15890: 
                   15891: # --------------------------------------------------------------Get annotation
                   15892: 
                   15893: sub get_annotation {
                   15894:     my ($symb,$enc) = @_;
                   15895: 
                   15896:     my $key = $symb;
                   15897:     if (!$enc) {
                   15898:         $key =
                   15899:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   15900:     }
                   15901:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   15902:     return $annotation{$key};
                   15903: }
                   15904: 
                   15905: sub clean_symb {
1.731     raeburn  15906:     my ($symb,$delete_enc) = @_;
1.685     tempelho 15907: 
                   15908:     &Apache::lonenc::check_decrypt(\$symb);
                   15909:     my $enc = $env{'request.enc'};
1.731     raeburn  15910:     if ($delete_enc) {
1.730     raeburn  15911:         delete($env{'request.enc'});
                   15912:     }
1.685     tempelho 15913: 
                   15914:     return ($symb,$enc);
                   15915: }
1.462     albertel 15916: 
1.1075.2.69  raeburn  15917: ############################################################
                   15918: ############################################################
                   15919: 
                   15920: =pod
                   15921: 
                   15922: =head1 Routines for building display used to search for courses
                   15923: 
                   15924: 
                   15925: =over 4
                   15926: 
                   15927: =item * &build_filters()
                   15928: 
                   15929: Create markup for a table used to set filters to use when selecting
                   15930: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   15931: and quotacheck.pl
                   15932: 
                   15933: 
                   15934: Inputs:
                   15935: 
                   15936: filterlist - anonymous array of fields to include as potential filters
                   15937: 
                   15938: crstype - course type
                   15939: 
                   15940: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   15941:               to pop-open a course selector (will contain "extra element").
                   15942: 
                   15943: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   15944: 
                   15945: filter - anonymous hash of criteria and their values
                   15946: 
                   15947: action - form action
                   15948: 
                   15949: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   15950: 
                   15951: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   15952: 
                   15953: cloneruname - username of owner of new course who wants to clone
                   15954: 
                   15955: clonerudom - domain of owner of new course who wants to clone
                   15956: 
                   15957: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   15958: 
                   15959: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   15960: 
                   15961: codedom - domain
                   15962: 
                   15963: formname - value of form element named "form".
                   15964: 
                   15965: fixeddom - domain, if fixed.
                   15966: 
                   15967: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   15968: 
                   15969: cnameelement - name of form element in form on opener page which will receive title of selected course
                   15970: 
                   15971: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   15972: 
                   15973: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   15974: 
                   15975: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   15976: 
                   15977: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   15978: 
                   15979: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   15980: 
                   15981: 
                   15982: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   15983: 
                   15984: 
                   15985: Side Effects: None
                   15986: 
                   15987: =cut
                   15988: 
                   15989: # ---------------------------------------------- search for courses based on last activity etc.
                   15990: 
                   15991: sub build_filters {
                   15992:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   15993:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   15994:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   15995:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   15996:         $clonetext,$clonewarning) = @_;
                   15997:     my ($list,$jscript);
                   15998:     my $onchange = 'javascript:updateFilters(this)';
                   15999:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   16000:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   16001:         $typeselectform,$instcodetitle);
                   16002:     if ($formname eq '') {
                   16003:         $formname = $caller;
                   16004:     }
                   16005:     foreach my $item (@{$filterlist}) {
                   16006:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   16007:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   16008:             if ($item eq 'domainfilter') {
                   16009:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   16010:             } elsif ($item eq 'coursefilter') {
                   16011:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   16012:             } elsif ($item eq 'ownerfilter') {
                   16013:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   16014:             } elsif ($item eq 'ownerdomfilter') {
                   16015:                 $filter->{'ownerdomfilter'} =
                   16016:                     &LONCAPA::clean_domain($filter->{$item});
                   16017:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   16018:                                                        'ownerdomfilter',1);
                   16019:             } elsif ($item eq 'personfilter') {
                   16020:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   16021:             } elsif ($item eq 'persondomfilter') {
                   16022:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   16023:                                                         'persondomfilter',1);
                   16024:             } else {
                   16025:                 $filter->{$item} =~ s/\W//g;
                   16026:             }
                   16027:             if (!$filter->{$item}) {
                   16028:                 $filter->{$item} = '';
                   16029:             }
                   16030:         }
                   16031:         if ($item eq 'domainfilter') {
                   16032:             my $allow_blank = 1;
                   16033:             if ($formname eq 'portform') {
                   16034:                 $allow_blank=0;
                   16035:             } elsif ($formname eq 'studentform') {
                   16036:                 $allow_blank=0;
                   16037:             }
                   16038:             if ($fixeddom) {
                   16039:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   16040:                                     ' value="'.$codedom.'" />'.
                   16041:                                     &Apache::lonnet::domain($codedom,'description');
                   16042:             } else {
                   16043:                 $domainselectform = &select_dom_form($filter->{$item},
                   16044:                                                      'domainfilter',
                   16045:                                                       $allow_blank,'',$onchange);
                   16046:             }
                   16047:         } else {
                   16048:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   16049:         }
                   16050:     }
                   16051: 
                   16052:     # last course activity filter and selection
                   16053:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   16054: 
                   16055:     # course created filter and selection
                   16056:     if (exists($filter->{'createdfilter'})) {
                   16057:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   16058:     }
                   16059: 
                   16060:     my %lt = &Apache::lonlocal::texthash(
                   16061:                 'cac' => "$crstype Activity",
                   16062:                 'ccr' => "$crstype Created",
                   16063:                 'cde' => "$crstype Title",
                   16064:                 'cdo' => "$crstype Domain",
                   16065:                 'ins' => 'Institutional Code',
                   16066:                 'inc' => 'Institutional Categorization',
                   16067:                 'cow' => "$crstype Owner/Co-owner",
                   16068:                 'cop' => "$crstype Personnel Includes",
                   16069:                 'cog' => 'Type',
                   16070:              );
                   16071: 
                   16072:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   16073:         my $typeval = 'Course';
                   16074:         if ($crstype eq 'Community') {
                   16075:             $typeval = 'Community';
                   16076:         }
                   16077:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   16078:     } else {
                   16079:         $typeselectform =  '<select name="type" size="1"';
                   16080:         if ($onchange) {
                   16081:             $typeselectform .= ' onchange="'.$onchange.'"';
                   16082:         }
                   16083:         $typeselectform .= '>'."\n";
                   16084:         foreach my $posstype ('Course','Community') {
                   16085:             $typeselectform.='<option value="'.$posstype.'"'.
                   16086:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   16087:         }
                   16088:         $typeselectform.="</select>";
                   16089:     }
                   16090: 
                   16091:     my ($cloneableonlyform,$cloneabletitle);
                   16092:     if (exists($filter->{'cloneableonly'})) {
                   16093:         my $cloneableon = '';
                   16094:         my $cloneableoff = ' checked="checked"';
                   16095:         if ($filter->{'cloneableonly'}) {
                   16096:             $cloneableon = $cloneableoff;
                   16097:             $cloneableoff = '';
                   16098:         }
                   16099:         $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>';
                   16100:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  16101:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  16102:         } else {
                   16103:             $cloneabletitle = &mt('Cloneable by you');
                   16104:         }
                   16105:     }
                   16106:     my $officialjs;
                   16107:     if ($crstype eq 'Course') {
                   16108:         if (exists($filter->{'instcodefilter'})) {
                   16109: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   16110: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   16111:             if ($codedom) {
                   16112:                 $officialjs = 1;
                   16113:                 ($instcodeform,$jscript,$$numtitlesref) =
                   16114:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   16115:                                                                   $officialjs,$codetitlesref);
                   16116:                 if ($jscript) {
                   16117:                     $jscript = '<script type="text/javascript">'."\n".
                   16118:                                '// <![CDATA['."\n".
                   16119:                                $jscript."\n".
                   16120:                                '// ]]>'."\n".
                   16121:                                '</script>'."\n";
                   16122:                 }
                   16123:             }
                   16124:             if ($instcodeform eq '') {
                   16125:                 $instcodeform =
                   16126:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   16127:                     $list->{'instcodefilter'}.'" />';
                   16128:                 $instcodetitle = $lt{'ins'};
                   16129:             } else {
                   16130:                 $instcodetitle = $lt{'inc'};
                   16131:             }
                   16132:             if ($fixeddom) {
                   16133:                 $instcodetitle .= '<br />('.$codedom.')';
                   16134:             }
                   16135:         }
                   16136:     }
                   16137:     my $output = qq|
                   16138: <form method="post" name="filterpicker" action="$action">
                   16139: <input type="hidden" name="form" value="$formname" />
                   16140: |;
                   16141:     if ($formname eq 'modifycourse') {
                   16142:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   16143:                    '<input type="hidden" name="prevphase" value="'.
                   16144:                    $prevphase.'" />'."\n";
1.1075.2.82  raeburn  16145:     } elsif ($formname eq 'quotacheck') {
                   16146:         $output .= qq|
                   16147: <input type="hidden" name="sortby" value="" />
                   16148: <input type="hidden" name="sortorder" value="" />
                   16149: |;
                   16150:     } else {
1.1075.2.69  raeburn  16151:         my $name_input;
                   16152:         if ($cnameelement ne '') {
                   16153:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   16154:                           $cnameelement.'" />';
                   16155:         }
                   16156:         $output .= qq|
                   16157: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   16158: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   16159: $name_input
                   16160: $roleelement
                   16161: $multelement
                   16162: $typeelement
                   16163: |;
                   16164:         if ($formname eq 'portform') {
                   16165:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   16166:         }
                   16167:     }
                   16168:     if ($fixeddom) {
                   16169:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   16170:     }
                   16171:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   16172:     if ($sincefilterform) {
                   16173:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   16174:                   .$sincefilterform
                   16175:                   .&Apache::lonhtmlcommon::row_closure();
                   16176:     }
                   16177:     if ($createdfilterform) {
                   16178:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   16179:                   .$createdfilterform
                   16180:                   .&Apache::lonhtmlcommon::row_closure();
                   16181:     }
                   16182:     if ($domainselectform) {
                   16183:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   16184:                   .$domainselectform
                   16185:                   .&Apache::lonhtmlcommon::row_closure();
                   16186:     }
                   16187:     if ($typeselectform) {
                   16188:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   16189:             $output .= $typeselectform;
                   16190:         } else {
                   16191:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   16192:                       .$typeselectform
                   16193:                       .&Apache::lonhtmlcommon::row_closure();
                   16194:         }
                   16195:     }
                   16196:     if ($instcodeform) {
                   16197:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   16198:                   .$instcodeform
                   16199:                   .&Apache::lonhtmlcommon::row_closure();
                   16200:     }
                   16201:     if (exists($filter->{'ownerfilter'})) {
                   16202:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   16203:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   16204:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   16205:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   16206:                    $ownerdomselectform.'</td></tr></table>'.
                   16207:                    &Apache::lonhtmlcommon::row_closure();
                   16208:     }
                   16209:     if (exists($filter->{'personfilter'})) {
                   16210:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   16211:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   16212:                    '<input type="text" name="personfilter" size="20" value="'.
                   16213:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   16214:                    $persondomselectform.'</td></tr></table>'.
                   16215:                    &Apache::lonhtmlcommon::row_closure();
                   16216:     }
                   16217:     if (exists($filter->{'coursefilter'})) {
                   16218:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   16219:                   .'<input type="text" name="coursefilter" size="25" value="'
                   16220:                   .$list->{'coursefilter'}.'" />'
                   16221:                   .&Apache::lonhtmlcommon::row_closure();
                   16222:     }
                   16223:     if ($cloneableonlyform) {
                   16224:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   16225:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   16226:     }
                   16227:     if (exists($filter->{'descriptfilter'})) {
                   16228:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   16229:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   16230:                   .$list->{'descriptfilter'}.'" />'
                   16231:                   .&Apache::lonhtmlcommon::row_closure(1);
                   16232:     }
                   16233:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   16234:                '<input type="hidden" name="updater" value="" />'."\n".
                   16235:                '<input type="submit" name="gosearch" value="'.
                   16236:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   16237:     return $jscript.$clonewarning.$output;
                   16238: }
                   16239: 
                   16240: =pod
                   16241: 
                   16242: =item * &timebased_select_form()
                   16243: 
                   16244: Create markup for a dropdown list used to select a time-based
                   16245: filter e.g., Course Activity, Course Created, when searching for courses
                   16246: or communities
                   16247: 
                   16248: Inputs:
                   16249: 
                   16250: item - name of form element (sincefilter or createdfilter)
                   16251: 
                   16252: filter - anonymous hash of criteria and their values
                   16253: 
                   16254: Returns: HTML for a select box contained a blank, then six time selections,
                   16255:          with value set in incoming form variables currently selected.
                   16256: 
                   16257: Side Effects: None
                   16258: 
                   16259: =cut
                   16260: 
                   16261: sub timebased_select_form {
                   16262:     my ($item,$filter) = @_;
                   16263:     if (ref($filter) eq 'HASH') {
                   16264:         $filter->{$item} =~ s/[^\d-]//g;
                   16265:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   16266:         return &select_form(
                   16267:                             $filter->{$item},
                   16268:                             $item,
                   16269:                             {      '-1' => '',
                   16270:                                 '86400' => &mt('today'),
                   16271:                                '604800' => &mt('last week'),
                   16272:                               '2592000' => &mt('last month'),
                   16273:                               '7776000' => &mt('last three months'),
                   16274:                              '15552000' => &mt('last six months'),
                   16275:                              '31104000' => &mt('last year'),
                   16276:                     'select_form_order' =>
                   16277:                            ['-1','86400','604800','2592000','7776000',
                   16278:                             '15552000','31104000']});
                   16279:     }
                   16280: }
                   16281: 
                   16282: =pod
                   16283: 
                   16284: =item * &js_changer()
                   16285: 
                   16286: Create script tag containing Javascript used to submit course search form
                   16287: when course type or domain is changed, and also to hide 'Searching ...' on
                   16288: page load completion for page showing search result.
                   16289: 
                   16290: Inputs: None
                   16291: 
                   16292: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   16293: 
                   16294: Side Effects: None
                   16295: 
                   16296: =cut
                   16297: 
                   16298: sub js_changer {
                   16299:     return <<ENDJS;
                   16300: <script type="text/javascript">
                   16301: // <![CDATA[
                   16302: function updateFilters(caller) {
                   16303:     if (typeof(caller) != "undefined") {
                   16304:         document.filterpicker.updater.value = caller.name;
                   16305:     }
                   16306:     document.filterpicker.submit();
                   16307: }
                   16308: 
                   16309: function hideSearching() {
                   16310:     if (document.getElementById('searching')) {
                   16311:         document.getElementById('searching').style.display = 'none';
                   16312:     }
                   16313:     return;
                   16314: }
                   16315: 
                   16316: // ]]>
                   16317: </script>
                   16318: 
                   16319: ENDJS
                   16320: }
                   16321: 
                   16322: =pod
                   16323: 
                   16324: =item * &search_courses()
                   16325: 
                   16326: Process selected filters form course search form and pass to lonnet::courseiddump
                   16327: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   16328: 
                   16329: Inputs:
                   16330: 
                   16331: dom - domain being searched
                   16332: 
                   16333: type - course type ('Course' or 'Community' or '.' if any).
                   16334: 
                   16335: filter - anonymous hash of criteria and their values
                   16336: 
                   16337: numtitles - for institutional codes - number of categories
                   16338: 
                   16339: cloneruname - optional username of new course owner
                   16340: 
                   16341: clonerudom - optional domain of new course owner
                   16342: 
1.1075.2.95  raeburn  16343: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69  raeburn  16344:             (used when DC is using course creation form)
                   16345: 
                   16346: codetitles - reference to array of titles of components in institutional codes (official courses).
                   16347: 
1.1075.2.95  raeburn  16348: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   16349:            (and so can clone automatically)
                   16350: 
                   16351: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   16352: 
                   16353: reqinstcode - institutional code of new course, where search_courses is used to identify potential
                   16354:               courses to clone
1.1075.2.69  raeburn  16355: 
                   16356: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   16357: 
                   16358: 
                   16359: Side Effects: None
                   16360: 
                   16361: =cut
                   16362: 
                   16363: 
                   16364: sub search_courses {
1.1075.2.95  raeburn  16365:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   16366:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69  raeburn  16367:     my (%courses,%showcourses,$cloner);
                   16368:     if (($filter->{'ownerfilter'} ne '') ||
                   16369:         ($filter->{'ownerdomfilter'} ne '')) {
                   16370:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   16371:                                        $filter->{'ownerdomfilter'};
                   16372:     }
                   16373:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   16374:         if (!$filter->{$item}) {
                   16375:             $filter->{$item}='.';
                   16376:         }
                   16377:     }
                   16378:     my $now = time;
                   16379:     my $timefilter =
                   16380:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   16381:     my ($createdbefore,$createdafter);
                   16382:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   16383:         $createdbefore = $now;
                   16384:         $createdafter = $now-$filter->{'createdfilter'};
                   16385:     }
                   16386:     my ($instcodefilter,$regexpok);
                   16387:     if ($numtitles) {
                   16388:         if ($env{'form.official'} eq 'on') {
                   16389:             $instcodefilter =
                   16390:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16391:             $regexpok = 1;
                   16392:         } elsif ($env{'form.official'} eq 'off') {
                   16393:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16394:             unless ($instcodefilter eq '') {
                   16395:                 $regexpok = -1;
                   16396:             }
                   16397:         }
                   16398:     } else {
                   16399:         $instcodefilter = $filter->{'instcodefilter'};
                   16400:     }
                   16401:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   16402:     if ($type eq '') { $type = '.'; }
                   16403: 
                   16404:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   16405:         $cloner = $cloneruname.':'.$clonerudom;
                   16406:     }
                   16407:     %courses = &Apache::lonnet::courseiddump($dom,
                   16408:                                              $filter->{'descriptfilter'},
                   16409:                                              $timefilter,
                   16410:                                              $instcodefilter,
                   16411:                                              $filter->{'combownerfilter'},
                   16412:                                              $filter->{'coursefilter'},
                   16413:                                              undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95  raeburn  16414:                                              undef,undef,$cloner,$cc_clone,
1.1075.2.69  raeburn  16415:                                              $filter->{'cloneableonly'},
                   16416:                                              $createdbefore,$createdafter,undef,
1.1075.2.95  raeburn  16417:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69  raeburn  16418:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   16419:         my $ccrole;
                   16420:         if ($type eq 'Community') {
                   16421:             $ccrole = 'co';
                   16422:         } else {
                   16423:             $ccrole = 'cc';
                   16424:         }
                   16425:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   16426:                                                      $filter->{'persondomfilter'},
                   16427:                                                      'userroles',undef,
                   16428:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   16429:                                                      $dom);
                   16430:         foreach my $role (keys(%rolehash)) {
                   16431:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   16432:             my $cid = $cdom.'_'.$cnum;
                   16433:             if (exists($courses{$cid})) {
                   16434:                 if (ref($courses{$cid}) eq 'HASH') {
                   16435:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   16436:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1075.2.119  raeburn  16437:                             push(@{$courses{$cid}{roles}},$courserole);
1.1075.2.69  raeburn  16438:                         }
                   16439:                     } else {
                   16440:                         $courses{$cid}{roles} = [$courserole];
                   16441:                     }
                   16442:                     $showcourses{$cid} = $courses{$cid};
                   16443:                 }
                   16444:             }
                   16445:         }
                   16446:         %courses = %showcourses;
                   16447:     }
                   16448:     return %courses;
                   16449: }
                   16450: 
                   16451: =pod
                   16452: 
                   16453: =back
                   16454: 
1.1075.2.88  raeburn  16455: =head1 Routines for version requirements for current course.
                   16456: 
                   16457: =over 4
                   16458: 
                   16459: =item * &check_release_required()
                   16460: 
                   16461: Compares required LON-CAPA version with version on server, and
                   16462: if required version is newer looks for a server with the required version.
                   16463: 
                   16464: Looks first at servers in user's owen domain; if none suitable, looks at
                   16465: servers in course's domain are permitted to host sessions for user's domain.
                   16466: 
                   16467: Inputs:
                   16468: 
                   16469: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16470: 
                   16471: $courseid - Course ID of current course
                   16472: 
                   16473: $rolecode - User's current role in course (for switchserver query string).
                   16474: 
                   16475: $required - LON-CAPA version needed by course (format: Major.Minor).
                   16476: 
                   16477: 
                   16478: Returns:
                   16479: 
                   16480: $switchserver - query string tp append to /adm/switchserver call (if
                   16481:                 current server's LON-CAPA version is too old.
                   16482: 
                   16483: $warning - Message is displayed if no suitable server could be found.
                   16484: 
                   16485: =cut
                   16486: 
                   16487: sub check_release_required {
                   16488:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   16489:     my ($switchserver,$warning);
                   16490:     if ($required ne '') {
                   16491:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   16492:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16493:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   16494:             my $otherserver;
                   16495:             if (($major eq '' && $minor eq '') ||
                   16496:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   16497:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   16498:                 my $switchlcrev =
                   16499:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   16500:                                                            $userdomserver);
                   16501:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16502:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   16503:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   16504:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   16505:                     if ($cdom ne $env{'user.domain'}) {
                   16506:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   16507:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   16508:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16509:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   16510:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   16511:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   16512:                         my $canhost =
                   16513:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   16514:                                                               $coursedomserver,
                   16515:                                                               $remoterev,
                   16516:                                                               $udomdefaults{'remotesessions'},
                   16517:                                                               $defdomdefaults{'hostedsessions'});
                   16518: 
                   16519:                         if ($canhost) {
                   16520:                             $otherserver = $coursedomserver;
                   16521:                         } else {
                   16522:                             $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.");
                   16523:                         }
                   16524:                     } else {
                   16525:                         $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).");
                   16526:                     }
                   16527:                 } else {
                   16528:                     $otherserver = $userdomserver;
                   16529:                 }
                   16530:             }
                   16531:             if ($otherserver ne '') {
                   16532:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   16533:             }
                   16534:         }
                   16535:     }
                   16536:     return ($switchserver,$warning);
                   16537: }
                   16538: 
                   16539: =pod
                   16540: 
                   16541: =item * &check_release_result()
                   16542: 
                   16543: Inputs:
                   16544: 
                   16545: $switchwarning - Warning message if no suitable server found to host session.
                   16546: 
                   16547: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16548:                 and current role.
                   16549: 
                   16550: Returns: HTML to display with information about requirement to switch server.
                   16551:          Either displaying warning with link to Roles/Courses screen or
                   16552:          display link to switchserver.
                   16553: 
1.1075.2.69  raeburn  16554: =cut
                   16555: 
1.1075.2.88  raeburn  16556: sub check_release_result {
                   16557:     my ($switchwarning,$switchserver) = @_;
                   16558:     my $output = &start_page('Selected course unavailable on this server').
                   16559:                  '<p class="LC_warning">';
                   16560:     if ($switchwarning) {
                   16561:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   16562:         if (&show_course()) {
                   16563:             $output .= &mt('Display courses');
                   16564:         } else {
                   16565:             $output .= &mt('Display roles');
                   16566:         }
                   16567:         $output .= '</a>';
                   16568:     } elsif ($switchserver) {
                   16569:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   16570:                    '<br />'.
                   16571:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   16572:                    &mt('Switch Server').
                   16573:                    '</a>';
                   16574:     }
                   16575:     $output .= '</p>'.&end_page();
                   16576:     return $output;
                   16577: }
                   16578: 
                   16579: =pod
                   16580: 
                   16581: =item * &needs_coursereinit()
                   16582: 
                   16583: Determine if course contents stored for user's session needs to be
                   16584: refreshed, because content has changed since "Big Hash" last tied.
                   16585: 
                   16586: Check for change is made if time last checked is more than 10 minutes ago
                   16587: (by default).
                   16588: 
                   16589: Inputs:
                   16590: 
                   16591: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16592: 
                   16593: $interval (optional) - Time which may elapse (in s) between last check for content
                   16594:                        change in current course. (default: 600 s).
                   16595: 
                   16596: Returns: an array; first element is:
                   16597: 
                   16598: =over 4
                   16599: 
                   16600: 'switch' - if content updates mean user's session
                   16601:            needs to be switched to a server running a newer LON-CAPA version
                   16602: 
                   16603: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   16604:            on current server hosting user's session
                   16605: 
                   16606: ''       - if no action required.
                   16607: 
                   16608: =back
                   16609: 
                   16610: If first item element is 'switch':
                   16611: 
                   16612: second item is $switchwarning - Warning message if no suitable server found to host session.
                   16613: 
                   16614: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16615:                               and current role.
                   16616: 
                   16617: otherwise: no other elements returned.
                   16618: 
                   16619: =back
                   16620: 
                   16621: =cut
                   16622: 
                   16623: sub needs_coursereinit {
                   16624:     my ($loncaparev,$interval) = @_;
                   16625:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   16626:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   16627:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   16628:     my $now = time;
                   16629:     if ($interval eq '') {
                   16630:         $interval = 600;
                   16631:     }
                   16632:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   16633:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16634:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                   16635:         if ($lastchange > $env{'request.course.tied'}) {
                   16636:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16637:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   16638:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   16639:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   16640:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   16641:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   16642:                     my ($switchserver,$switchwarning) =
                   16643:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   16644:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   16645:                     if ($switchwarning ne '' || $switchserver ne '') {
                   16646:                         return ('switch',$switchwarning,$switchserver);
                   16647:                     }
                   16648:                 }
                   16649:             }
                   16650:             return ('update');
                   16651:         }
                   16652:     }
                   16653:     return ();
                   16654: }
1.1075.2.69  raeburn  16655: 
1.1075.2.11  raeburn  16656: sub update_content_constraints {
                   16657:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16658:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16659:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   16660:     my %checkresponsetypes;
                   16661:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   16662:         my ($item,$name,$value) = split(/:/,$key);
                   16663:         if ($item eq 'resourcetag') {
                   16664:             if ($name eq 'responsetype') {
                   16665:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   16666:             }
                   16667:         }
                   16668:     }
                   16669:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16670:     if (defined($navmap)) {
                   16671:         my %allresponses;
                   16672:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   16673:             my %responses = $res->responseTypes();
                   16674:             foreach my $key (keys(%responses)) {
                   16675:                 next unless(exists($checkresponsetypes{$key}));
                   16676:                 $allresponses{$key} += $responses{$key};
                   16677:             }
                   16678:         }
                   16679:         foreach my $key (keys(%allresponses)) {
                   16680:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   16681:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   16682:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   16683:             }
                   16684:         }
                   16685:         undef($navmap);
                   16686:     }
                   16687:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   16688:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   16689:     }
                   16690:     return;
                   16691: }
                   16692: 
1.1075.2.27  raeburn  16693: sub allmaps_incourse {
                   16694:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16695:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   16696:         $cid = $env{'request.course.id'};
                   16697:         $cdom = $env{'course.'.$cid.'.domain'};
                   16698:         $cnum = $env{'course.'.$cid.'.num'};
                   16699:         $chome = $env{'course.'.$cid.'.home'};
                   16700:     }
                   16701:     my %allmaps = ();
                   16702:     my $lastchange =
                   16703:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16704:     if ($lastchange > $env{'request.course.tied'}) {
                   16705:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   16706:         unless ($ferr) {
                   16707:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   16708:         }
                   16709:     }
                   16710:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16711:     if (defined($navmap)) {
                   16712:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   16713:             $allmaps{$res->src()} = 1;
                   16714:         }
                   16715:     }
                   16716:     return \%allmaps;
                   16717: }
                   16718: 
1.1075.2.11  raeburn  16719: sub parse_supplemental_title {
                   16720:     my ($title) = @_;
                   16721: 
                   16722:     my ($foldertitle,$renametitle);
                   16723:     if ($title =~ /&amp;&amp;&amp;/) {
                   16724:         $title = &HTML::Entites::decode($title);
                   16725:     }
                   16726:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   16727:         $renametitle=$4;
                   16728:         my ($time,$uname,$udom) = ($1,$2,$3);
                   16729:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   16730:         my $name =  &plainname($uname,$udom);
                   16731:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   16732:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   16733:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   16734:             $name.': <br />'.$foldertitle;
                   16735:     }
                   16736:     if (wantarray) {
                   16737:         return ($title,$foldertitle,$renametitle);
                   16738:     }
                   16739:     return $title;
                   16740: }
                   16741: 
1.1075.2.43  raeburn  16742: sub recurse_supplemental {
                   16743:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   16744:     if ($suppmap) {
                   16745:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   16746:         if ($fatal) {
                   16747:             $errors ++;
                   16748:         } else {
                   16749:             if ($#LONCAPA::map::resources > 0) {
                   16750:                 foreach my $res (@LONCAPA::map::resources) {
                   16751:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   16752:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  16753:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   16754:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  16755:                         } else {
                   16756:                             $numfiles ++;
                   16757:                         }
                   16758:                     }
                   16759:                 }
                   16760:             }
                   16761:         }
                   16762:     }
                   16763:     return ($numfiles,$errors);
                   16764: }
                   16765: 
1.1075.2.18  raeburn  16766: sub symb_to_docspath {
1.1075.2.119  raeburn  16767:     my ($symb,$navmapref) = @_;
                   16768:     return unless ($symb && ref($navmapref));
1.1075.2.18  raeburn  16769:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   16770:     if ($resurl=~/\.(sequence|page)$/) {
                   16771:         $mapurl=$resurl;
                   16772:     } elsif ($resurl eq 'adm/navmaps') {
                   16773:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   16774:     }
                   16775:     my $mapresobj;
1.1075.2.119  raeburn  16776:     unless (ref($$navmapref)) {
                   16777:         $$navmapref = Apache::lonnavmaps::navmap->new();
                   16778:     }
                   16779:     if (ref($$navmapref)) {
                   16780:         $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1075.2.18  raeburn  16781:     }
                   16782:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   16783:     my $type=$2;
                   16784:     my $path;
                   16785:     if (ref($mapresobj)) {
                   16786:         my $pcslist = $mapresobj->map_hierarchy();
                   16787:         if ($pcslist ne '') {
                   16788:             foreach my $pc (split(/,/,$pcslist)) {
                   16789:                 next if ($pc <= 1);
1.1075.2.119  raeburn  16790:                 my $res = $$navmapref->getByMapPc($pc);
1.1075.2.18  raeburn  16791:                 if (ref($res)) {
                   16792:                     my $thisurl = $res->src();
                   16793:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   16794:                     my $thistitle = $res->title();
                   16795:                     $path .= '&'.
                   16796:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  16797:                              &escape($thistitle).
1.1075.2.18  raeburn  16798:                              ':'.$res->randompick().
                   16799:                              ':'.$res->randomout().
                   16800:                              ':'.$res->encrypted().
                   16801:                              ':'.$res->randomorder().
                   16802:                              ':'.$res->is_page();
                   16803:                 }
                   16804:             }
                   16805:         }
                   16806:         $path =~ s/^\&//;
                   16807:         my $maptitle = $mapresobj->title();
                   16808:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  16809:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  16810:         }
                   16811:         $path .= (($path ne '')? '&' : '').
                   16812:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  16813:                  &escape($maptitle).
1.1075.2.18  raeburn  16814:                  ':'.$mapresobj->randompick().
                   16815:                  ':'.$mapresobj->randomout().
                   16816:                  ':'.$mapresobj->encrypted().
                   16817:                  ':'.$mapresobj->randomorder().
                   16818:                  ':'.$mapresobj->is_page();
                   16819:     } else {
                   16820:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   16821:         my $ispage = (($type eq 'page')? 1 : '');
                   16822:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  16823:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  16824:         }
                   16825:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  16826:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  16827:     }
                   16828:     unless ($mapurl eq 'default') {
                   16829:         $path = 'default&'.
1.1075.2.46  raeburn  16830:                 &escape('Main Content').
1.1075.2.18  raeburn  16831:                 ':::::&'.$path;
                   16832:     }
                   16833:     return $path;
                   16834: }
                   16835: 
1.1075.2.14  raeburn  16836: sub captcha_display {
1.1075.2.137  raeburn  16837:     my ($context,$lonhost,$defdom) = @_;
1.1075.2.14  raeburn  16838:     my ($output,$error);
1.1075.2.107  raeburn  16839:     my ($captcha,$pubkey,$privkey,$version) =
1.1075.2.137  raeburn  16840:         &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14  raeburn  16841:     if ($captcha eq 'original') {
                   16842:         $output = &create_captcha();
                   16843:         unless ($output) {
                   16844:             $error = 'captcha';
                   16845:         }
                   16846:     } elsif ($captcha eq 'recaptcha') {
1.1075.2.107  raeburn  16847:         $output = &create_recaptcha($pubkey,$version);
1.1075.2.14  raeburn  16848:         unless ($output) {
                   16849:             $error = 'recaptcha';
                   16850:         }
                   16851:     }
1.1075.2.107  raeburn  16852:     return ($output,$error,$captcha,$version);
1.1075.2.14  raeburn  16853: }
                   16854: 
                   16855: sub captcha_response {
1.1075.2.137  raeburn  16856:     my ($context,$lonhost,$defdom) = @_;
1.1075.2.14  raeburn  16857:     my ($captcha_chk,$captcha_error);
1.1075.2.137  raeburn  16858:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14  raeburn  16859:     if ($captcha eq 'original') {
                   16860:         ($captcha_chk,$captcha_error) = &check_captcha();
                   16861:     } elsif ($captcha eq 'recaptcha') {
1.1075.2.107  raeburn  16862:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1075.2.14  raeburn  16863:     } else {
                   16864:         $captcha_chk = 1;
                   16865:     }
                   16866:     return ($captcha_chk,$captcha_error);
                   16867: }
                   16868: 
                   16869: sub get_captcha_config {
1.1075.2.137  raeburn  16870:     my ($context,$lonhost,$dom_in_effect) = @_;
1.1075.2.107  raeburn  16871:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1075.2.14  raeburn  16872:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   16873:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   16874:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16875:     if ($context eq 'usercreation') {
                   16876:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   16877:         if (ref($domconfig{$context}) eq 'HASH') {
                   16878:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   16879:             if (ref($hashtocheck) eq 'HASH') {
                   16880:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   16881:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   16882:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   16883:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   16884:                     }
                   16885:                     if ($privkey && $pubkey) {
                   16886:                         $captcha = 'recaptcha';
1.1075.2.107  raeburn  16887:                         $version = $hashtocheck->{'recaptchaversion'};
                   16888:                         if ($version ne '2') {
                   16889:                             $version = 1;
                   16890:                         }
1.1075.2.14  raeburn  16891:                     } else {
                   16892:                         $captcha = 'original';
                   16893:                     }
                   16894:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   16895:                     $captcha = 'original';
                   16896:                 }
                   16897:             }
                   16898:         } else {
                   16899:             $captcha = 'captcha';
                   16900:         }
                   16901:     } elsif ($context eq 'login') {
                   16902:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   16903:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   16904:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   16905:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   16906:             if ($privkey && $pubkey) {
                   16907:                 $captcha = 'recaptcha';
1.1075.2.107  raeburn  16908:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   16909:                 if ($version ne '2') {
                   16910:                     $version = 1;
                   16911:                 }
1.1075.2.14  raeburn  16912:             } else {
                   16913:                 $captcha = 'original';
                   16914:             }
                   16915:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   16916:             $captcha = 'original';
                   16917:         }
1.1075.2.137  raeburn  16918:     } elsif ($context eq 'passwords') {
                   16919:         if ($dom_in_effect) {
                   16920:             my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
                   16921:             if ($passwdconf{'captcha'} eq 'recaptcha') {
                   16922:                 if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
                   16923:                     $pubkey = $passwdconf{'recaptchakeys'}{'public'};
                   16924:                     $privkey = $passwdconf{'recaptchakeys'}{'private'};
                   16925:                 }
                   16926:                 if ($privkey && $pubkey) {
                   16927:                     $captcha = 'recaptcha';
                   16928:                     $version = $passwdconf{'recaptchaversion'};
                   16929:                     if ($version ne '2') {
                   16930:                         $version = 1;
                   16931:                     }
                   16932:                 } else {
                   16933:                     $captcha = 'original';
                   16934:                 }
                   16935:             } elsif ($passwdconf{'captcha'} ne 'notused') {
                   16936:                 $captcha = 'original';
                   16937:             }
                   16938:         }
1.1075.2.14  raeburn  16939:     }
1.1075.2.107  raeburn  16940:     return ($captcha,$pubkey,$privkey,$version);
1.1075.2.14  raeburn  16941: }
                   16942: 
                   16943: sub create_captcha {
                   16944:     my %captcha_params = &captcha_settings();
                   16945:     my ($output,$maxtries,$tries) = ('',10,0);
                   16946:     while ($tries < $maxtries) {
                   16947:         $tries ++;
                   16948:         my $captcha = Authen::Captcha->new (
                   16949:                                            output_folder => $captcha_params{'output_dir'},
                   16950:                                            data_folder   => $captcha_params{'db_dir'},
                   16951:                                           );
                   16952:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   16953: 
                   16954:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   16955:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   16956:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  16957:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   16958:                       '<br />'.
                   16959:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  16960:             last;
                   16961:         }
                   16962:     }
                   16963:     return $output;
                   16964: }
                   16965: 
                   16966: sub captcha_settings {
                   16967:     my %captcha_params = (
                   16968:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   16969:                            www_output_dir => "/captchaspool",
                   16970:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   16971:                            numchars       => '5',
                   16972:                          );
                   16973:     return %captcha_params;
                   16974: }
                   16975: 
                   16976: sub check_captcha {
                   16977:     my ($captcha_chk,$captcha_error);
                   16978:     my $code = $env{'form.code'};
                   16979:     my $md5sum = $env{'form.crypt'};
                   16980:     my %captcha_params = &captcha_settings();
                   16981:     my $captcha = Authen::Captcha->new(
                   16982:                       output_folder => $captcha_params{'output_dir'},
                   16983:                       data_folder   => $captcha_params{'db_dir'},
                   16984:                   );
1.1075.2.26  raeburn  16985:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  16986:     my %captcha_hash = (
                   16987:                         0       => 'Code not checked (file error)',
                   16988:                        -1      => 'Failed: code expired',
                   16989:                        -2      => 'Failed: invalid code (not in database)',
                   16990:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   16991:     );
                   16992:     if ($captcha_chk != 1) {
                   16993:         $captcha_error = $captcha_hash{$captcha_chk}
                   16994:     }
                   16995:     return ($captcha_chk,$captcha_error);
                   16996: }
                   16997: 
                   16998: sub create_recaptcha {
1.1075.2.107  raeburn  16999:     my ($pubkey,$version) = @_;
                   17000:     if ($version >= 2) {
                   17001:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
                   17002:     } else {
                   17003:         my $use_ssl;
                   17004:         if ($ENV{'SERVER_PORT'} == 443) {
                   17005:             $use_ssl = 1;
                   17006:         }
                   17007:         my $captcha = Captcha::reCAPTCHA->new;
                   17008:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   17009:                $captcha->get_html($pubkey,undef,$use_ssl).
                   17010:                &mt('If the text is hard to read, [_1] will replace them.',
                   17011:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   17012:                '<br /><br />';
                   17013:      }
1.1075.2.14  raeburn  17014: }
                   17015: 
                   17016: sub check_recaptcha {
1.1075.2.107  raeburn  17017:     my ($privkey,$version) = @_;
1.1075.2.14  raeburn  17018:     my $captcha_chk;
1.1075.2.107  raeburn  17019:     if ($version >= 2) {
                   17020:         my $ua = LWP::UserAgent->new;
                   17021:         $ua->timeout(10);
                   17022:         my %info = (
                   17023:                      secret   => $privkey,
                   17024:                      response => $env{'form.g-recaptcha-response'},
                   17025:                      remoteip => $ENV{'REMOTE_ADDR'},
                   17026:                    );
                   17027:         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
                   17028:         if ($response->is_success)  {
                   17029:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   17030:             if (ref($data) eq 'HASH') {
                   17031:                 if ($data->{'success'}) {
                   17032:                     $captcha_chk = 1;
                   17033:                 }
                   17034:             }
                   17035:         }
                   17036:     } else {
                   17037:         my $captcha = Captcha::reCAPTCHA->new;
                   17038:         my $captcha_result =
                   17039:             $captcha->check_answer(
                   17040:                                     $privkey,
                   17041:                                     $ENV{'REMOTE_ADDR'},
                   17042:                                     $env{'form.recaptcha_challenge_field'},
                   17043:                                     $env{'form.recaptcha_response_field'},
                   17044:                                   );
                   17045:         if ($captcha_result->{is_valid}) {
                   17046:             $captcha_chk = 1;
                   17047:         }
1.1075.2.14  raeburn  17048:     }
                   17049:     return $captcha_chk;
                   17050: }
                   17051: 
1.1075.2.64  raeburn  17052: sub emailusername_info {
1.1075.2.103  raeburn  17053:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64  raeburn  17054:     my %titles = &Apache::lonlocal::texthash (
                   17055:                      lastname      => 'Last Name',
                   17056:                      firstname     => 'First Name',
                   17057:                      institution   => 'School/college/university',
                   17058:                      location      => "School's city, state/province, country",
                   17059:                      web           => "School's web address",
                   17060:                      officialemail => 'E-mail address at institution (if different)',
1.1075.2.103  raeburn  17061:                      id            => 'Student/Employee ID',
1.1075.2.64  raeburn  17062:                  );
                   17063:     return (\@fields,\%titles);
                   17064: }
                   17065: 
1.1075.2.56  raeburn  17066: sub cleanup_html {
                   17067:     my ($incoming) = @_;
                   17068:     my $outgoing;
                   17069:     if ($incoming ne '') {
                   17070:         $outgoing = $incoming;
                   17071:         $outgoing =~ s/;/&#059;/g;
                   17072:         $outgoing =~ s/\#/&#035;/g;
                   17073:         $outgoing =~ s/\&/&#038;/g;
                   17074:         $outgoing =~ s/</&#060;/g;
                   17075:         $outgoing =~ s/>/&#062;/g;
                   17076:         $outgoing =~ s/\(/&#040/g;
                   17077:         $outgoing =~ s/\)/&#041;/g;
                   17078:         $outgoing =~ s/"/&#034;/g;
                   17079:         $outgoing =~ s/'/&#039;/g;
                   17080:         $outgoing =~ s/\$/&#036;/g;
                   17081:         $outgoing =~ s{/}{&#047;}g;
                   17082:         $outgoing =~ s/=/&#061;/g;
                   17083:         $outgoing =~ s/\\/&#092;/g
                   17084:     }
                   17085:     return $outgoing;
                   17086: }
                   17087: 
1.1075.2.74  raeburn  17088: # Checks for critical messages and returns a redirect url if one exists.
                   17089: # $interval indicates how often to check for messages.
                   17090: sub critical_redirect {
                   17091:     my ($interval) = @_;
                   17092:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   17093:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   17094:                                         $env{'user.name'});
                   17095:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   17096:         my $redirecturl;
                   17097:         if ($what[0]) {
                   17098:             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   17099:                 $redirecturl='/adm/email?critical=display';
                   17100:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   17101:                 return (1, $url);
                   17102:             }
                   17103:         }
                   17104:     }
                   17105:     return ();
                   17106: }
                   17107: 
1.1075.2.64  raeburn  17108: # Use:
                   17109: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   17110: #
                   17111: ##################################################
                   17112: #          password associated functions         #
                   17113: ##################################################
                   17114: sub des_keys {
                   17115:     # Make a new key for DES encryption.
                   17116:     # Each key has two parts which are returned separately.
                   17117:     # Please note:  Each key must be passed through the &hex function
                   17118:     # before it is output to the web browser.  The hex versions cannot
                   17119:     # be used to decrypt.
                   17120:     my @hexstr=('0','1','2','3','4','5','6','7',
                   17121:                 '8','9','a','b','c','d','e','f');
                   17122:     my $lkey='';
                   17123:     for (0..7) {
                   17124:         $lkey.=$hexstr[rand(15)];
                   17125:     }
                   17126:     my $ukey='';
                   17127:     for (0..7) {
                   17128:         $ukey.=$hexstr[rand(15)];
                   17129:     }
                   17130:     return ($lkey,$ukey);
                   17131: }
                   17132: 
                   17133: sub des_decrypt {
                   17134:     my ($key,$cyphertext) = @_;
                   17135:     my $keybin=pack("H16",$key);
                   17136:     my $cypher;
                   17137:     if ($Crypt::DES::VERSION>=2.03) {
                   17138:         $cypher=new Crypt::DES $keybin;
                   17139:     } else {
                   17140:         $cypher=new DES $keybin;
                   17141:     }
1.1075.2.106  raeburn  17142:     my $plaintext='';
                   17143:     my $cypherlength = length($cyphertext);
                   17144:     my $numchunks = int($cypherlength/32);
                   17145:     for (my $j=0; $j<$numchunks; $j++) {
                   17146:         my $start = $j*32;
                   17147:         my $cypherblock = substr($cyphertext,$start,32);
                   17148:         my $chunk =
                   17149:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   17150:         $chunk .=
                   17151:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   17152:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   17153:         $plaintext .= $chunk;
                   17154:     }
1.1075.2.64  raeburn  17155:     return $plaintext;
                   17156: }
                   17157: 
1.1075.2.135  raeburn  17158: sub is_nonframeable {
                   17159:     my ($url,$absolute,$hostname,$ip,$nocache) = @_;
                   17160:     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
                   17161:     return if (($remprotocol eq '') || ($remhost eq ''));
                   17162: 
                   17163:     $remprotocol = lc($remprotocol);
                   17164:     $remhost = lc($remhost);
                   17165:     my $remport = 80;
                   17166:     if ($remprotocol eq 'https') {
                   17167:         $remport = 443;
                   17168:     }
                   17169:     my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
                   17170:     if ($cached) {
                   17171:         unless ($nocache) {
                   17172:             if ($result) {
                   17173:                 return 1;
                   17174:             } else {
                   17175:                 return 0;
                   17176:             }
                   17177:         }
                   17178:     }
                   17179:     my $uselink;
                   17180:     my $request = new HTTP::Request('HEAD',$url);
                   17181:     my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
                   17182:     if ($response->is_success()) {
                   17183:         my $secpolicy = lc($response->header('content-security-policy'));
                   17184:         my $xframeop = lc($response->header('x-frame-options'));
                   17185:         $secpolicy =~ s/^\s+|\s+$//g;
                   17186:         $xframeop =~ s/^\s+|\s+$//g;
                   17187:         if (($secpolicy ne '') || ($xframeop ne '')) {
                   17188:             my $remotehost = $remprotocol.'://'.$remhost;
                   17189:             my ($origin,$protocol,$port);
                   17190:             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                   17191:                 $port = $ENV{'SERVER_PORT'};
                   17192:             } else {
                   17193:                 $port = 80;
                   17194:             }
                   17195:             if ($absolute eq '') {
                   17196:                 $protocol = 'http:';
                   17197:                 if ($port == 443) {
                   17198:                     $protocol = 'https:';
                   17199:                 }
                   17200:                 $origin = $protocol.'//'.lc($hostname);
                   17201:             } else {
                   17202:                 $origin = lc($absolute);
                   17203:                 ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
                   17204:             }
                   17205:             if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
                   17206:                 my $framepolicy = $1;
                   17207:                 $framepolicy =~ s/^\s+|\s+$//g;
                   17208:                 my @policies = split(/\s+/,$framepolicy);
                   17209:                 if (@policies) {
                   17210:                     if (grep(/^\Q'none'\E$/,@policies)) {
                   17211:                         $uselink = 1;
                   17212:                     } else {
                   17213:                         $uselink = 1;
                   17214:                         if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
                   17215:                                 (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
                   17216:                                 (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
                   17217:                             undef($uselink);
                   17218:                         }
                   17219:                         if ($uselink) {
                   17220:                             if (grep(/^\Q'self'\E$/,@policies)) {
                   17221:                                 if (($origin ne '') && ($remotehost eq $origin)) {
                   17222:                                     undef($uselink);
                   17223:                                 }
                   17224:                             }
                   17225:                         }
                   17226:                         if ($uselink) {
                   17227:                             my @possok;
                   17228:                             if ($ip ne '') {
                   17229:                                 push(@possok,$ip);
                   17230:                             }
                   17231:                             my $hoststr = '';
                   17232:                             foreach my $part (reverse(split(/\./,$hostname))) {
                   17233:                                 if ($hoststr eq '') {
                   17234:                                     $hoststr = $part;
                   17235:                                 } else {
                   17236:                                     $hoststr = "$part.$hoststr";
                   17237:                                 }
                   17238:                                 if ($hoststr eq $hostname) {
                   17239:                                     push(@possok,$hostname);
                   17240:                                 } else {
                   17241:                                     push(@possok,"*.$hoststr");
                   17242:                                 }
                   17243:                             }
                   17244:                             if (@possok) {
                   17245:                                 foreach my $poss (@possok) {
                   17246:                                     last if (!$uselink);
                   17247:                                     foreach my $policy (@policies) {
                   17248:                                         if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
                   17249:                                             undef($uselink);
                   17250:                                             last;
                   17251:                                         }
                   17252:                                     }
                   17253:                                 }
                   17254:                             }
                   17255:                         }
                   17256:                     }
                   17257:                 }
                   17258:             } elsif ($xframeop ne '') {
                   17259:                 $uselink = 1;
                   17260:                 my @policies = split(/\s*,\s*/,$xframeop);
                   17261:                 if (@policies) {
                   17262:                     unless (grep(/^deny$/,@policies)) {
                   17263:                         if ($origin ne '') {
                   17264:                             if (grep(/^sameorigin$/,@policies)) {
                   17265:                                 if ($remotehost eq $origin) {
                   17266:                                     undef($uselink);
                   17267:                                 }
                   17268:                             }
                   17269:                             if ($uselink) {
                   17270:                                 foreach my $policy (@policies) {
                   17271:                                     if ($policy =~ /^allow-from\s*(.+)$/) {
                   17272:                                         my $allowfrom = $1;
                   17273:                                         if (($allowfrom ne '') && ($allowfrom eq $origin)) {
                   17274:                                             undef($uselink);
                   17275:                                             last;
                   17276:                                         }
                   17277:                                     }
                   17278:                                 }
                   17279:                             }
                   17280:                         }
                   17281:                     }
                   17282:                 }
                   17283:             }
                   17284:         }
                   17285:     }
                   17286:     if ($nocache) {
                   17287:         if ($cached) {
                   17288:             my $devalidate;
                   17289:             if ($uselink && !$result) {
                   17290:                 $devalidate = 1;
                   17291:             } elsif (!$uselink && $result) {
                   17292:                 $devalidate = 1;
                   17293:             }
                   17294:             if ($devalidate) {
                   17295:                 &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
                   17296:             }
                   17297:         }
                   17298:     } else {
                   17299:         if ($uselink) {
                   17300:             $result = 1;
                   17301:         } else {
                   17302:             $result = 0;
                   17303:         }
                   17304:         &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
                   17305:     }
                   17306:     return $uselink;
                   17307: }
                   17308: 
1.112     bowersj2 17309: 1;
                   17310: __END__;
1.41      ng       17311: 

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