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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1403  ! raeburn     4: # $Id: loncommon.pm,v 1.1402 2023/03/27 18:41:04 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.1383    raeburn    64: use Apache::lonnavmaps();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.1182    raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.1280    raeburn    74: use LONCAPA::LWPReq;
1.1395    raeburn    75: use LONCAPA::map();
1.1328    raeburn    76: use HTTP::Request;
1.657     raeburn    77: use DateTime::TimeZone;
1.1241    raeburn    78: use DateTime::Locale;
1.1220    raeburn    79: use Encode();
1.1091    foxr       80: use Text::Aspell;
1.1094    raeburn    81: use Authen::Captcha;
                     82: use Captcha::reCAPTCHA;
1.1234    raeburn    83: use JSON::DWIW;
1.1174    raeburn    84: use Crypt::DES;
                     85: use DynaLoader; # for Crypt::DES version
1.1223    musolffc   86: use MIME::Lite;
                     87: use MIME::Types;
1.1292    raeburn    88: use File::Copy();
1.1300    raeburn    89: use File::Path();
1.1309    raeburn    90: use String::CRC32();
                     91: use Short::URL();
1.117     www        92: 
1.517     raeburn    93: # ---------------------------------------------- Designs
                     94: use vars qw(%defaultdesign);
                     95: 
1.22      www        96: my $readit;
                     97: 
1.517     raeburn    98: 
1.157     matthew    99: ##
                    100: ## Global Variables
                    101: ##
1.46      matthew   102: 
1.643     foxr      103: 
                    104: # ----------------------------------------------- SSI with retries:
                    105: #
                    106: 
                    107: =pod
                    108: 
1.648     raeburn   109: =head1 Server Side include with retries:
1.643     foxr      110: 
                    111: =over 4
                    112: 
1.648     raeburn   113: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      114: 
                    115: Performs an ssi with some number of retries.  Retries continue either
                    116: until the result is ok or until the retry count supplied by the
                    117: caller is exhausted.  
                    118: 
                    119: Inputs:
1.648     raeburn   120: 
                    121: =over 4
                    122: 
1.643     foxr      123: resource   - Identifies the resource to insert.
1.648     raeburn   124: 
1.643     foxr      125: retries    - Count of the number of retries allowed.
1.648     raeburn   126: 
1.643     foxr      127: form       - Hash that identifies the rendering options.
                    128: 
1.648     raeburn   129: =back
                    130: 
                    131: Returns:
                    132: 
                    133: =over 4
                    134: 
1.643     foxr      135: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   136: 
1.643     foxr      137: response   - The response from the last attempt (which may or may not have been successful.
                    138: 
1.648     raeburn   139: =back
                    140: 
                    141: =back
                    142: 
1.643     foxr      143: =cut
                    144: 
                    145: sub ssi_with_retries {
                    146:     my ($resource, $retries, %form) = @_;
                    147: 
                    148: 
                    149:     my $ok = 0;			# True if we got a good response.
                    150:     my $content;
                    151:     my $response;
                    152: 
                    153:     # Try to get the ssi done. within the retries count:
                    154: 
                    155:     do {
                    156: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    157: 	$ok      = $response->is_success;
1.650     www       158:         if (!$ok) {
                    159:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    160:         }
1.643     foxr      161: 	$retries--;
                    162:     } while (!$ok && ($retries > 0));
                    163: 
                    164:     if (!$ok) {
                    165: 	$content = '';		# On error return an empty content.
                    166:     }
                    167:     return ($content, $response);
                    168: 
                    169: }
                    170: 
                    171: 
                    172: 
1.20      www       173: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  174: my %language;
1.124     www       175: my %supported_language;
1.1088    foxr      176: my %supported_codes;
1.1048    foxr      177: my %latex_language;		# For choosing hyphenation in <transl..>
                    178: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  179: my %cprtag;
1.192     taceyjo1  180: my %scprtag;
1.351     www       181: my %fe; my %fd; my %fm;
1.41      ng        182: my %category_extensions;
1.12      harris41  183: 
1.46      matthew   184: # ---------------------------------------------- Thesaurus variables
1.144     matthew   185: #
                    186: # %Keywords:
                    187: #      A hash used by &keyword to determine if a word is considered a keyword.
                    188: # $thesaurus_db_file 
                    189: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   190: 
                    191: my %Keywords;
                    192: my $thesaurus_db_file;
                    193: 
1.144     matthew   194: #
                    195: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    196: # thesaurus.tab, and filecategories.tab.
                    197: #
1.18      www       198: BEGIN {
1.46      matthew   199:     # Variable initialization
                    200:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    201:     #
1.22      www       202:     unless ($readit) {
1.12      harris41  203: # ------------------------------------------------------------------- languages
                    204:     {
1.158     raeburn   205:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    206:                                    '/language.tab';
1.1317    raeburn   207:         if ( open(my $fh,'<',$langtabfile) ) {
1.356     albertel  208:             while (my $line = <$fh>) {
                    209:                 next if ($line=~/^\#/);
                    210:                 chomp($line);
1.1088    foxr      211:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   212:                 $language{$key}=$val.' - '.$enc;
                    213:                 if ($sup) {
                    214:                     $supported_language{$key}=$sup;
1.1088    foxr      215: 		    $supported_codes{$key}   = $code;
1.158     raeburn   216:                 }
1.1048    foxr      217: 		if ($latex) {
                    218: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      219: 		    $latex_language{$code} = $latex;
1.1048    foxr      220: 		}
1.158     raeburn   221:             }
                    222:             close($fh);
                    223:         }
1.12      harris41  224:     }
                    225: # ------------------------------------------------------------------ copyrights
                    226:     {
1.158     raeburn   227:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    228:                                   '/copyright.tab';
1.1317    raeburn   229:         if ( open (my $fh,'<',$copyrightfile) ) {
1.356     albertel  230:             while (my $line = <$fh>) {
                    231:                 next if ($line=~/^\#/);
                    232:                 chomp($line);
                    233:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   234:                 $cprtag{$key}=$val;
                    235:             }
                    236:             close($fh);
                    237:         }
1.12      harris41  238:     }
1.351     www       239: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  240:     {
                    241:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    242:                                   '/source_copyright.tab';
1.1317    raeburn   243:         if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356     albertel  244:             while (my $line = <$fh>) {
                    245:                 next if ($line =~ /^\#/);
                    246:                 chomp($line);
                    247:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  248:                 $scprtag{$key}=$val;
                    249:             }
                    250:             close($fh);
                    251:         }
                    252:     }
1.63      www       253: 
1.517     raeburn   254: # -------------------------------------------------------------- default domain designs
1.63      www       255:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   256:     my $designfile = $designdir.'/default.tab';
1.1317    raeburn   257:     if ( open (my $fh,'<',$designfile) ) {
1.517     raeburn   258:         while (my $line = <$fh>) {
                    259:             next if ($line =~ /^\#/);
                    260:             chomp($line);
                    261:             my ($key,$val)=(split(/\=/,$line));
                    262:             if ($val) { $defaultdesign{$key}=$val; }
                    263:         }
                    264:         close($fh);
1.63      www       265:     }
                    266: 
1.15      harris41  267: # ------------------------------------------------------------- file categories
                    268:     {
1.158     raeburn   269:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    270:                                   '/filecategories.tab';
1.1317    raeburn   271:         if ( open (my $fh,'<',$categoryfile) ) {
1.356     albertel  272: 	    while (my $line = <$fh>) {
                    273: 		next if ($line =~ /^\#/);
                    274: 		chomp($line);
                    275:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.1263    raeburn   276:                 push(@{$category_extensions{lc($category)}},$extension);
1.158     raeburn   277:             }
                    278:             close($fh);
                    279:         }
                    280: 
1.15      harris41  281:     }
1.12      harris41  282: # ------------------------------------------------------------------ file types
                    283:     {
1.158     raeburn   284:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    285:                '/filetypes.tab';
1.1317    raeburn   286:         if ( open (my $fh,'<',$typesfile) ) {
1.356     albertel  287:             while (my $line = <$fh>) {
                    288: 		next if ($line =~ /^\#/);
                    289: 		chomp($line);
                    290:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   291:                 if ($descr ne '') {
                    292:                     $fe{$ending}=lc($emb);
                    293:                     $fd{$ending}=$descr;
1.351     www       294:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   295:                 }
                    296:             }
                    297:             close($fh);
                    298:         }
1.12      harris41  299:     }
1.22      www       300:     &Apache::lonnet::logthis(
1.705     tempelho  301:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       302:     $readit=1;
1.46      matthew   303:     }  # end of unless($readit) 
1.32      matthew   304:     
                    305: }
1.112     bowersj2  306: 
1.42      matthew   307: ###############################################################
                    308: ##           HTML and Javascript Helper Functions            ##
                    309: ###############################################################
                    310: 
                    311: =pod 
                    312: 
1.112     bowersj2  313: =head1 HTML and Javascript Functions
1.42      matthew   314: 
1.112     bowersj2  315: =over 4
                    316: 
1.648     raeburn   317: =item * &browser_and_searcher_javascript()
1.112     bowersj2  318: 
                    319: X<browsing, javascript>X<searching, javascript>Returns a string
                    320: containing javascript with two functions, C<openbrowser> and
                    321: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    322: tags.
1.42      matthew   323: 
1.648     raeburn   324: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   325: 
                    326: inputs: formname, elementname, only, omit
                    327: 
                    328: formname and elementname indicate the name of the html form and name of
                    329: the element that the results of the browsing selection are to be placed in. 
                    330: 
                    331: Specifying 'only' will restrict the browser to displaying only files
1.185     www       332: with the given extension.  Can be a comma separated list.
1.42      matthew   333: 
                    334: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       335: with the given extension.  Can be a comma separated list.
1.42      matthew   336: 
1.648     raeburn   337: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   338: 
                    339: Inputs: formname, elementname
                    340: 
                    341: formname and elementname specify the name of the html form and the name
                    342: of the element the selection from the search results will be placed in.
1.542     raeburn   343: 
1.42      matthew   344: =cut
                    345: 
                    346: sub browser_and_searcher_javascript {
1.199     albertel  347:     my ($mode)=@_;
                    348:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  349:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   350:     return <<END;
1.219     albertel  351: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   352:     var editbrowser = null;
1.135     albertel  353:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       354:         var url = '$resurl/?';
1.42      matthew   355:         if (editbrowser == null) {
                    356:             url += 'launch=1&';
                    357:         }
                    358:         url += 'catalogmode=interactive&';
1.199     albertel  359:         url += 'mode=$mode&';
1.611     albertel  360:         url += 'inhibitmenu=yes&';
1.42      matthew   361:         url += 'form=' + formname + '&';
                    362:         if (only != null) {
                    363:             url += 'only=' + only + '&';
1.217     albertel  364:         } else {
                    365:             url += 'only=&';
                    366: 	}
1.42      matthew   367:         if (omit != null) {
                    368:             url += 'omit=' + omit + '&';
1.217     albertel  369:         } else {
                    370:             url += 'omit=&';
                    371: 	}
1.135     albertel  372:         if (titleelement != null) {
                    373:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  374:         } else {
                    375: 	    url += 'titleelement=&';
                    376: 	}
1.42      matthew   377:         url += 'element=' + elementname + '';
                    378:         var title = 'Browser';
1.435     albertel  379:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   380:         options += ',width=700,height=600';
                    381:         editbrowser = open(url,title,options,'1');
                    382:         editbrowser.focus();
                    383:     }
                    384:     var editsearcher;
1.135     albertel  385:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   386:         var url = '/adm/searchcat?';
                    387:         if (editsearcher == null) {
                    388:             url += 'launch=1&';
                    389:         }
                    390:         url += 'catalogmode=interactive&';
1.199     albertel  391:         url += 'mode=$mode&';
1.42      matthew   392:         url += 'form=' + formname + '&';
1.135     albertel  393:         if (titleelement != null) {
                    394:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  395:         } else {
                    396: 	    url += 'titleelement=&';
                    397: 	}
1.42      matthew   398:         url += 'element=' + elementname + '';
                    399:         var title = 'Search';
1.435     albertel  400:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   401:         options += ',width=700,height=600';
                    402:         editsearcher = open(url,title,options,'1');
                    403:         editsearcher.focus();
                    404:     }
1.219     albertel  405: // END LON-CAPA Internal -->
1.42      matthew   406: END
1.170     www       407: }
                    408: 
                    409: sub lastresurl {
1.258     albertel  410:     if ($env{'environment.lastresurl'}) {
                    411: 	return $env{'environment.lastresurl'}
1.170     www       412:     } else {
                    413: 	return '/res';
                    414:     }
                    415: }
                    416: 
                    417: sub storeresurl {
                    418:     my $resurl=&Apache::lonnet::clutter(shift);
                    419:     unless ($resurl=~/^\/res/) { return 0; }
                    420:     $resurl=~s/\/$//;
                    421:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   422:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       423:     return 1;
1.42      matthew   424: }
                    425: 
1.74      www       426: sub studentbrowser_javascript {
1.111     www       427:    unless (
1.258     albertel  428:             (($env{'request.course.id'}) && 
1.302     albertel  429:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    430: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    431: 					  '/'.$env{'request.course.sec'})
                    432: 	      ))
1.258     albertel  433:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       434:           ) { return ''; }  
1.74      www       435:    return (<<'ENDSTDBRW');
1.776     bisitz    436: <script type="text/javascript" language="Javascript">
1.824     bisitz    437: // <![CDATA[
1.74      www       438:     var stdeditbrowser;
1.1337    raeburn   439:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
1.74      www       440:         var url = '/adm/pickstudent?';
                    441:         var filter;
1.558     albertel  442: 	if (!ignorefilter) {
                    443: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    444: 	}
1.74      www       445:         if (filter != null) {
                    446:            if (filter != '') {
                    447:                url += 'filter='+filter+'&';
                    448: 	   }
                    449:         }
                    450:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       451:                                     '&udomelement='+udom+
                    452:                                     '&clicker='+clicker;
1.111     www       453: 	if (roleflag) { url+="&roles=1"; }
1.1337    raeburn   454:         if (courseadv == 'condition') {
                    455:             if (document.getElementById('courseadv')) {
                    456:                 courseadv = document.getElementById('courseadv').value;
                    457:             }
                    458:         }
                    459:         if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.102     www       460:         var title = 'Student_Browser';
1.74      www       461:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    462:         options += ',width=700,height=600';
                    463:         stdeditbrowser = open(url,title,options,'1');
                    464:         stdeditbrowser.focus();
                    465:     }
1.824     bisitz    466: // ]]>
1.74      www       467: </script>
                    468: ENDSTDBRW
                    469: }
1.42      matthew   470: 
1.1003    www       471: sub resourcebrowser_javascript {
                    472:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       473:    return (<<'ENDRESBRW');
1.1003    www       474: <script type="text/javascript" language="Javascript">
                    475: // <![CDATA[
                    476:     var reseditbrowser;
1.1004    www       477:     function openresbrowser(formname,reslink) {
1.1005    www       478:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       479:         var title = 'Resource_Browser';
                    480:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       481:         options += ',width=700,height=500';
1.1004    www       482:         reseditbrowser = open(url,title,options,'1');
                    483:         reseditbrowser.focus();
1.1003    www       484:     }
                    485: // ]]>
                    486: </script>
1.1004    www       487: ENDRESBRW
1.1003    www       488: }
                    489: 
1.74      www       490: sub selectstudent_link {
1.1337    raeburn   491:    my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
1.999     www       492:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    493:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    494:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  495:    if ($env{'request.course.id'}) {  
1.302     albertel  496:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    497: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    498: 					'/'.$env{'request.course.sec'})) {
1.111     www       499: 	   return '';
                    500:        }
1.999     www       501:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1337    raeburn   502:        if ($courseadv eq 'only') {
                    503:            $callargs .= ",'',1,'$courseadv'";
                    504:        } elsif ($courseadv eq 'none') {
                    505:            $callargs .= ",'','','$courseadv'";
                    506:        } elsif ($courseadv eq 'condition') {
                    507:            $callargs .= ",'','','$courseadv'";
1.793     raeburn   508:        }
                    509:        return '<span class="LC_nobreak">'.
                    510:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    511:               &mt('Select User').'</a></span>';
1.74      www       512:    }
1.258     albertel  513:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       514:        $callargs .= ",'',1"; 
1.793     raeburn   515:        return '<span class="LC_nobreak">'.
                    516:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    517:               &mt('Select User').'</a></span>';
1.111     www       518:    }
                    519:    return '';
1.91      www       520: }
                    521: 
1.1004    www       522: sub selectresource_link {
                    523:    my ($form,$reslink,$arg)=@_;
                    524:    
                    525:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    526:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    527:    unless ($env{'request.course.id'}) { return $arg; }
                    528:    return '<span class="LC_nobreak">'.
                    529:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    530:               $arg.'</a></span>';
                    531: }
                    532: 
                    533: 
                    534: 
1.653     raeburn   535: sub authorbrowser_javascript {
                    536:     return <<"ENDAUTHORBRW";
1.776     bisitz    537: <script type="text/javascript" language="JavaScript">
1.824     bisitz    538: // <![CDATA[
1.653     raeburn   539: var stdeditbrowser;
                    540: 
                    541: function openauthorbrowser(formname,udom) {
                    542:     var url = '/adm/pickauthor?';
                    543:     url += 'form='+formname+'&roledom='+udom;
                    544:     var title = 'Author_Browser';
                    545:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    546:     options += ',width=700,height=600';
                    547:     stdeditbrowser = open(url,title,options,'1');
                    548:     stdeditbrowser.focus();
                    549: }
                    550: 
1.824     bisitz    551: // ]]>
1.653     raeburn   552: </script>
                    553: ENDAUTHORBRW
                    554: }
                    555: 
1.91      www       556: sub coursebrowser_javascript {
1.1116    raeburn   557:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221    raeburn   558:         $credits_element,$instcode) = @_;
1.932     raeburn   559:     my $wintitle = 'Course_Browser';
1.931     raeburn   560:     if ($crstype eq 'Community') {
1.932     raeburn   561:         $wintitle = 'Community_Browser';
1.909     raeburn   562:     }
1.876     raeburn   563:     my $id_functions = &javascript_index_functions();
                    564:     my $output = '
1.776     bisitz    565: <script type="text/javascript" language="JavaScript">
1.824     bisitz    566: // <![CDATA[
1.468     raeburn   567:     var stdeditbrowser;'."\n";
1.876     raeburn   568: 
                    569:     $output .= <<"ENDSTDBRW";
1.909     raeburn   570:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       571:         var url = '/adm/pickcourse?';
1.895     raeburn   572:         var formid = getFormIdByName(formname);
1.876     raeburn   573:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  574:         if (domainfilter != null) {
                    575:            if (domainfilter != '') {
                    576:                url += 'domainfilter='+domainfilter+'&';
                    577: 	   }
                    578:         }
1.91      www       579:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  580: 	                            '&cdomelement='+udom+
                    581:                                     '&cnameelement='+desc;
1.468     raeburn   582:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   583:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   584:                 url += '&roleelement='+extra_element;
                    585:                 if (domainfilter == null || domainfilter == '') {
                    586:                     url += '&domainfilter='+extra_element;
                    587:                 }
1.234     raeburn   588:             }
1.468     raeburn   589:             else {
                    590:                 if (formname == 'portform') {
                    591:                     url += '&setroles='+extra_element;
1.800     raeburn   592:                 } else {
                    593:                     if (formname == 'rules') {
                    594:                         url += '&fixeddom='+extra_element; 
                    595:                     }
1.468     raeburn   596:                 }
                    597:             }     
1.230     raeburn   598:         }
1.909     raeburn   599:         if (type != null && type != '') {
                    600:             url += '&type='+type;
                    601:         }
                    602:         if (type_elem != null && type_elem != '') {
                    603:             url += '&typeelement='+type_elem;
                    604:         }
1.872     raeburn   605:         if (formname == 'ccrs') {
                    606:             var ownername = document.forms[formid].ccuname.value;
                    607:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238    raeburn   608:             url += '&cloner='+ownername+':'+ownerdom;
                    609:             if (type == 'Course') {
                    610:                 url += '&crscode='+document.forms[formid].crscode.value;
                    611:             }
1.1221    raeburn   612:         }
                    613:         if (formname == 'requestcrs') {
                    614:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   615:         }
1.293     raeburn   616:         if (multflag !=null && multflag != '') {
                    617:             url += '&multiple='+multflag;
                    618:         }
1.909     raeburn   619:         var title = '$wintitle';
1.91      www       620:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    621:         options += ',width=700,height=600';
                    622:         stdeditbrowser = open(url,title,options,'1');
                    623:         stdeditbrowser.focus();
                    624:     }
1.876     raeburn   625: $id_functions
                    626: ENDSTDBRW
1.1116    raeburn   627:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    628:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    629:                                       $credits_element);
1.876     raeburn   630:     }
                    631:     $output .= '
                    632: // ]]>
                    633: </script>';
                    634:     return $output;
                    635: }
                    636: 
                    637: sub javascript_index_functions {
                    638:     return <<"ENDJS";
                    639: 
                    640: function getFormIdByName(formname) {
                    641:     for (var i=0;i<document.forms.length;i++) {
                    642:         if (document.forms[i].name == formname) {
                    643:             return i;
                    644:         }
                    645:     }
                    646:     return -1;
                    647: }
                    648: 
                    649: function getIndexByName(formid,item) {
                    650:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    651:         if (document.forms[formid].elements[i].name == item) {
                    652:             return i;
                    653:         }
                    654:     }
                    655:     return -1;
                    656: }
1.468     raeburn   657: 
1.876     raeburn   658: function getDomainFromSelectbox(formname,udom) {
                    659:     var userdom;
                    660:     var formid = getFormIdByName(formname);
                    661:     if (formid > -1) {
                    662:         var domid = getIndexByName(formid,udom);
                    663:         if (domid > -1) {
                    664:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    665:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    666:             }
                    667:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    668:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   669:             }
                    670:         }
                    671:     }
1.876     raeburn   672:     return userdom;
                    673: }
                    674: 
                    675: ENDJS
1.468     raeburn   676: 
1.876     raeburn   677: }
                    678: 
1.1017    raeburn   679: sub javascript_array_indexof {
1.1018    raeburn   680:     return <<ENDJS;
1.1017    raeburn   681: <script type="text/javascript" language="JavaScript">
                    682: // <![CDATA[
                    683: 
                    684: if (!Array.prototype.indexOf) {
                    685:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    686:         "use strict";
                    687:         if (this === void 0 || this === null) {
                    688:             throw new TypeError();
                    689:         }
                    690:         var t = Object(this);
                    691:         var len = t.length >>> 0;
                    692:         if (len === 0) {
                    693:             return -1;
                    694:         }
                    695:         var n = 0;
                    696:         if (arguments.length > 0) {
                    697:             n = Number(arguments[1]);
1.1088    foxr      698:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   699:                 n = 0;
                    700:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    701:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    702:             }
                    703:         }
                    704:         if (n >= len) {
                    705:             return -1;
                    706:         }
                    707:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    708:         for (; k < len; k++) {
                    709:             if (k in t && t[k] === searchElement) {
                    710:                 return k;
                    711:             }
                    712:         }
                    713:         return -1;
                    714:     }
                    715: }
                    716: 
                    717: // ]]>
                    718: </script>
                    719: 
                    720: ENDJS
                    721: 
                    722: }
                    723: 
1.876     raeburn   724: sub userbrowser_javascript {
                    725:     my $id_functions = &javascript_index_functions();
                    726:     return <<"ENDUSERBRW";
                    727: 
1.888     raeburn   728: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   729:     var url = '/adm/pickuser?';
                    730:     var userdom = getDomainFromSelectbox(formname,udom);
                    731:     if (userdom != null) {
                    732:        if (userdom != '') {
                    733:            url += 'srchdom='+userdom+'&';
                    734:        }
                    735:     }
                    736:     url += 'form=' + formname + '&unameelement='+uname+
                    737:                                 '&udomelement='+udom+
                    738:                                 '&ulastelement='+ulast+
                    739:                                 '&ufirstelement='+ufirst+
                    740:                                 '&uemailelement='+uemail+
1.881     raeburn   741:                                 '&hideudomelement='+hideudom+
                    742:                                 '&coursedom='+crsdom;
1.888     raeburn   743:     if ((caller != null) && (caller != undefined)) {
                    744:         url += '&caller='+caller;
                    745:     }
1.876     raeburn   746:     var title = 'User_Browser';
                    747:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    748:     options += ',width=700,height=600';
                    749:     var stdeditbrowser = open(url,title,options,'1');
                    750:     stdeditbrowser.focus();
                    751: }
                    752: 
1.888     raeburn   753: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   754:     var formid = getFormIdByName(formname);
                    755:     if (formid > -1) {
1.888     raeburn   756:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   757:         var domid = getIndexByName(formid,udom);
                    758:         var hidedomid = getIndexByName(formid,origdom);
                    759:         if (hidedomid > -1) {
                    760:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   761:             var unameval = document.forms[formid].elements[unameid].value;
                    762:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    763:                 if (domid > -1) {
                    764:                     var slct = document.forms[formid].elements[domid];
                    765:                     if (slct.type == 'select-one') {
                    766:                         var i;
                    767:                         for (i=0;i<slct.length;i++) {
                    768:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    769:                         }
                    770:                     }
                    771:                     if (slct.type == 'hidden') {
                    772:                         slct.value = fixeddom;
1.876     raeburn   773:                     }
                    774:                 }
1.468     raeburn   775:             }
                    776:         }
                    777:     }
1.876     raeburn   778:     return;
                    779: }
                    780: 
                    781: $id_functions
                    782: ENDUSERBRW
1.468     raeburn   783: }
                    784: 
                    785: sub setsec_javascript {
1.1116    raeburn   786:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   787:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    788:         $communityrolestr);
                    789:     if ($role_element ne '') {
                    790:         my @allroles = ('st','ta','ep','in','ad');
                    791:         foreach my $crstype ('Course','Community') {
                    792:             if ($crstype eq 'Community') {
                    793:                 foreach my $role (@allroles) {
                    794:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    795:                 }
                    796:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    797:             } else {
                    798:                 foreach my $role (@allroles) {
                    799:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    800:                 }
                    801:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    802:             }
                    803:         }
                    804:         $rolestr = '"'.join('","',@allroles).'"';
                    805:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    806:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    807:     }
1.468     raeburn   808:     my $setsections = qq|
                    809: function setSect(sectionlist) {
1.629     raeburn   810:     var sectionsArray = new Array();
                    811:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    812:         sectionsArray = sectionlist.split(",");
                    813:     }
1.468     raeburn   814:     var numSections = sectionsArray.length;
                    815:     document.$formname.$sec_element.length = 0;
                    816:     if (numSections == 0) {
                    817:         document.$formname.$sec_element.multiple=false;
                    818:         document.$formname.$sec_element.size=1;
                    819:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    820:     } else {
                    821:         if (numSections == 1) {
                    822:             document.$formname.$sec_element.multiple=false;
                    823:             document.$formname.$sec_element.size=1;
                    824:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    825:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    826:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    827:         } else {
                    828:             for (var i=0; i<numSections; i++) {
                    829:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    830:             }
                    831:             document.$formname.$sec_element.multiple=true
                    832:             if (numSections < 3) {
                    833:                 document.$formname.$sec_element.size=numSections;
                    834:             } else {
                    835:                 document.$formname.$sec_element.size=3;
                    836:             }
                    837:             document.$formname.$sec_element.options[0].selected = false
                    838:         }
                    839:     }
1.91      www       840: }
1.905     raeburn   841: 
                    842: function setRole(crstype) {
1.468     raeburn   843: |;
1.905     raeburn   844:     if ($role_element eq '') {
                    845:         $setsections .= '    return;
                    846: }
                    847: ';
                    848:     } else {
                    849:         $setsections .= qq|
                    850:     var elementLength = document.$formname.$role_element.length;
                    851:     var allroles = Array($rolestr);
                    852:     var courserolenames = Array($courserolestr);
                    853:     var communityrolenames = Array($communityrolestr);
                    854:     if (elementLength != undefined) {
                    855:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    856:             if (crstype == 'Course') {
                    857:                 return;
                    858:             } else {
                    859:                 allroles[5] = 'co';
                    860:                 for (var i=0; i<6; i++) {
                    861:                     document.$formname.$role_element.options[i].value = allroles[i];
                    862:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    863:                 }
                    864:             }
                    865:         } else {
                    866:             if (crstype == 'Community') {
                    867:                 return;
                    868:             } else {
                    869:                 allroles[5] = 'cc';
                    870:                 for (var i=0; i<6; i++) {
                    871:                     document.$formname.$role_element.options[i].value = allroles[i];
                    872:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    873:                 }
                    874:             }
                    875:         }
                    876:     }
                    877:     return;
                    878: }
                    879: |;
                    880:     }
1.1116    raeburn   881:     if ($credits_element) {
                    882:         $setsections .= qq|
                    883: function setCredits(defaultcredits) {
                    884:     document.$formname.$credits_element.value = defaultcredits;
                    885:     return;
                    886: }
                    887: |;
                    888:     }
1.468     raeburn   889:     return $setsections;
                    890: }
                    891: 
1.91      www       892: sub selectcourse_link {
1.909     raeburn   893:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    894:        $typeelement) = @_;
                    895:    my $type = $selecttype;
1.871     raeburn   896:    my $linktext = &mt('Select Course');
                    897:    if ($selecttype eq 'Community') {
1.909     raeburn   898:        $linktext = &mt('Select Community');
1.1239    raeburn   899:    } elsif ($selecttype eq 'Placement') {
                    900:        $linktext = &mt('Select Placement Test'); 
1.906     raeburn   901:    } elsif ($selecttype eq 'Course/Community') {
                    902:        $linktext = &mt('Select Course/Community');
1.909     raeburn   903:        $type = '';
1.1019    raeburn   904:    } elsif ($selecttype eq 'Select') {
                    905:        $linktext = &mt('Select');
                    906:        $type = '';
1.871     raeburn   907:    }
1.787     bisitz    908:    return '<span class="LC_nobreak">'
                    909:          ."<a href='"
                    910:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    911:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   912:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   913:          ."'>".$linktext.'</a>'
1.787     bisitz    914:          .'</span>';
1.74      www       915: }
1.42      matthew   916: 
1.653     raeburn   917: sub selectauthor_link {
                    918:    my ($form,$udom)=@_;
                    919:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    920:           &mt('Select Author').'</a>';
                    921: }
                    922: 
1.876     raeburn   923: sub selectuser_link {
1.881     raeburn   924:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   925:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   926:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   927:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   928:            ');">'.$linktext.'</a>';
1.876     raeburn   929: }
                    930: 
1.273     raeburn   931: sub check_uncheck_jscript {
                    932:     my $jscript = <<"ENDSCRT";
                    933: function checkAll(field) {
                    934:     if (field.length > 0) {
                    935:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   936:             if (!field[i].disabled) { 
                    937:                 field[i].checked = true;
                    938:             }
1.273     raeburn   939:         }
                    940:     } else {
1.1093    raeburn   941:         if (!field.disabled) { 
                    942:             field.checked = true;
                    943:         }
1.273     raeburn   944:     }
                    945: }
                    946:  
                    947: function uncheckAll(field) {
                    948:     if (field.length > 0) {
                    949:         for (i = 0; i < field.length; i++) {
                    950:             field[i].checked = false ;
1.543     albertel  951:         }
                    952:     } else {
1.273     raeburn   953:         field.checked = false ;
                    954:     }
                    955: }
                    956: ENDSCRT
                    957:     return $jscript;
                    958: }
                    959: 
1.656     www       960: sub select_timezone {
1.1387    raeburn   961:    my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;
                    962:    my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";
1.659     raeburn   963:    if ($includeempty) {
                    964:        $output .= '<option value=""';
                    965:        if (($selected eq '') || ($selected eq 'local')) {
                    966:            $output .= ' selected="selected" ';
                    967:        }
                    968:        $output .= '> </option>';
                    969:    }
1.657     raeburn   970:    my @timezones = DateTime::TimeZone->all_names;
                    971:    foreach my $tzone (@timezones) {
                    972:        $output.= '<option value="'.$tzone.'"';
                    973:        if ($tzone eq $selected) {
                    974:            $output.=' selected="selected"';
                    975:        }
                    976:        $output.=">$tzone</option>\n";
1.656     www       977:    }
                    978:    $output.="</select>";
                    979:    return $output;
                    980: }
1.273     raeburn   981: 
1.687     raeburn   982: sub select_datelocale {
1.1256    raeburn   983:     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    984:     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687     raeburn   985:     if ($includeempty) {
                    986:         $output .= '<option value=""';
                    987:         if ($selected eq '') {
                    988:             $output .= ' selected="selected" ';
                    989:         }
                    990:         $output .= '> </option>';
                    991:     }
1.1241    raeburn   992:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   993:     my (@possibles,%locale_names);
1.1241    raeburn   994:     my @locales = DateTime::Locale->ids();
                    995:     foreach my $id (@locales) {
                    996:         if ($id ne '') {
                    997:             my ($en_terr,$native_terr);
                    998:             my $loc = DateTime::Locale->load($id);
                    999:             if (ref($loc)) {
                   1000:                 $en_terr = $loc->name();
                   1001:                 $native_terr = $loc->native_name();
1.687     raeburn  1002:                 if (grep(/^en$/,@languages) || !@languages) {
                   1003:                     if ($en_terr ne '') {
                   1004:                         $locale_names{$id} = '('.$en_terr.')';
                   1005:                     } elsif ($native_terr ne '') {
                   1006:                         $locale_names{$id} = $native_terr;
                   1007:                     }
                   1008:                 } else {
                   1009:                     if ($native_terr ne '') {
                   1010:                         $locale_names{$id} = $native_terr.' ';
                   1011:                     } elsif ($en_terr ne '') {
                   1012:                         $locale_names{$id} = '('.$en_terr.')';
                   1013:                     }
                   1014:                 }
1.1220    raeburn  1015:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241    raeburn  1016:                 push(@possibles,$id);
                   1017:             } 
1.687     raeburn  1018:         }
                   1019:     }
                   1020:     foreach my $item (sort(@possibles)) {
                   1021:         $output.= '<option value="'.$item.'"';
                   1022:         if ($item eq $selected) {
                   1023:             $output.=' selected="selected"';
                   1024:         }
                   1025:         $output.=">$item";
                   1026:         if ($locale_names{$item} ne '') {
1.1220    raeburn  1027:             $output.='  '.$locale_names{$item};
1.687     raeburn  1028:         }
                   1029:         $output.="</option>\n";
                   1030:     }
                   1031:     $output.="</select>";
                   1032:     return $output;
                   1033: }
                   1034: 
1.792     raeburn  1035: sub select_language {
1.1256    raeburn  1036:     my ($name,$selected,$includeempty,$noedit) = @_;
1.792     raeburn  1037:     my %langchoices;
                   1038:     if ($includeempty) {
1.1117    raeburn  1039:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1040:     }
                   1041:     foreach my $id (&languageids()) {
                   1042:         my $code = &supportedlanguagecode($id);
                   1043:         if ($code) {
                   1044:             $langchoices{$code} = &plainlanguagedescription($id);
                   1045:         }
                   1046:     }
1.1117    raeburn  1047:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256    raeburn  1048:     return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792     raeburn  1049: }
                   1050: 
1.42      matthew  1051: =pod
1.36      matthew  1052: 
1.1088    foxr     1053: 
                   1054: =item * &list_languages()
                   1055: 
                   1056: Returns an array reference that is suitable for use in language prompters.
                   1057: Each array element is itself a two element array.  The first element
                   1058: is the language code.  The second element a descsriptiuon of the 
                   1059: language itself.  This is suitable for use in e.g.
                   1060: &Apache::edit::select_arg (once dereferenced that is).
                   1061: 
                   1062: =cut 
                   1063: 
                   1064: sub list_languages {
                   1065:     my @lang_choices;
                   1066: 
                   1067:     foreach my $id (&languageids()) {
                   1068: 	my $code = &supportedlanguagecode($id);
                   1069: 	if ($code) {
                   1070: 	    my $selector    = $supported_codes{$id};
                   1071: 	    my $description = &plainlanguagedescription($id);
1.1263    raeburn  1072: 	    push(@lang_choices, [$selector, $description]);
1.1088    foxr     1073: 	}
                   1074:     }
                   1075:     return \@lang_choices;
                   1076: }
                   1077: 
                   1078: =pod
                   1079: 
1.648     raeburn  1080: =item * &linked_select_forms(...)
1.36      matthew  1081: 
                   1082: linked_select_forms returns a string containing a <script></script> block
                   1083: and html for two <select> menus.  The select menus will be linked in that
                   1084: changing the value of the first menu will result in new values being placed
                   1085: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1086: order unless a defined order is provided.
1.36      matthew  1087: 
                   1088: linked_select_forms takes the following ordered inputs:
                   1089: 
                   1090: =over 4
                   1091: 
1.112     bowersj2 1092: =item * $formname, the name of the <form> tag
1.36      matthew  1093: 
1.112     bowersj2 1094: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1095: 
1.112     bowersj2 1096: =item * $firstdefault, the default value for the first menu
1.36      matthew  1097: 
1.112     bowersj2 1098: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1099: 
1.112     bowersj2 1100: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1101: 
1.112     bowersj2 1102: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1103: 
1.609     raeburn  1104: =item * $menuorder, the order of values in the first menu
                   1105: 
1.1115    raeburn  1106: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1107:         event for the first <select> tag
                   1108: 
                   1109: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1110:         event for the second <select> tag
                   1111: 
1.1245    raeburn  1112: =item * $suffix, to differentiate separate uses of select2data javascript
                   1113:         objects in a page.
                   1114: 
1.41      ng       1115: =back 
                   1116: 
1.36      matthew  1117: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1118: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1119: values for the first select menu.  The text that coincides with the 
1.41      ng       1120: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1121: and text for the second menu are given in the hash pointed to by 
                   1122: $menu{$choice1}->{'select2'}.  
                   1123: 
1.112     bowersj2 1124:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1125:                        default => "B3",
                   1126:                        select2 => { 
                   1127:                            B1 => "Choice B1",
                   1128:                            B2 => "Choice B2",
                   1129:                            B3 => "Choice B3",
                   1130:                            B4 => "Choice B4"
1.609     raeburn  1131:                            },
                   1132:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1133:                    },
                   1134:                A2 => { text =>"Choice A2" ,
                   1135:                        default => "C2",
                   1136:                        select2 => { 
                   1137:                            C1 => "Choice C1",
                   1138:                            C2 => "Choice C2",
                   1139:                            C3 => "Choice C3"
1.609     raeburn  1140:                            },
                   1141:                        order => ['C2','C1','C3'],
1.112     bowersj2 1142:                    },
                   1143:                A3 => { text =>"Choice A3" ,
                   1144:                        default => "D6",
                   1145:                        select2 => { 
                   1146:                            D1 => "Choice D1",
                   1147:                            D2 => "Choice D2",
                   1148:                            D3 => "Choice D3",
                   1149:                            D4 => "Choice D4",
                   1150:                            D5 => "Choice D5",
                   1151:                            D6 => "Choice D6",
                   1152:                            D7 => "Choice D7"
1.609     raeburn  1153:                            },
                   1154:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1155:                    }
                   1156:                );
1.36      matthew  1157: 
                   1158: =cut
                   1159: 
                   1160: sub linked_select_forms {
                   1161:     my ($formname,
                   1162:         $middletext,
                   1163:         $firstdefault,
                   1164:         $firstselectname,
                   1165:         $secondselectname, 
1.609     raeburn  1166:         $hashref,
                   1167:         $menuorder,
1.1115    raeburn  1168:         $onchangefirst,
1.1245    raeburn  1169:         $onchangesecond,
                   1170:         $suffix
1.36      matthew  1171:         ) = @_;
                   1172:     my $second = "document.$formname.$secondselectname";
                   1173:     my $first = "document.$formname.$firstselectname";
                   1174:     # output the javascript to do the changing
                   1175:     my $result = '';
1.776     bisitz   1176:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1177:     $result.="// <![CDATA[\n";
1.1245    raeburn  1178:     $result.="var select2data${suffix} = new Object();\n";
1.36      matthew  1179:     $" = '","';
                   1180:     my $debug = '';
                   1181:     foreach my $s1 (sort(keys(%$hashref))) {
1.1245    raeburn  1182:         $result.="select2data${suffix}['d_$s1'] = new Object();\n";        
                   1183:         $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36      matthew  1184:             $hashref->{$s1}->{'default'}."');\n";
1.1245    raeburn  1185:         $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36      matthew  1186:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1187:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1188:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1189:         }
1.36      matthew  1190:         $result.="\"@s2values\");\n";
1.1245    raeburn  1191:         $result.="select2data${suffix}['d_$s1'].texts = new Array(";        
1.36      matthew  1192:         my @s2texts;
                   1193:         foreach my $value (@s2values) {
1.1263    raeburn  1194:             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36      matthew  1195:         }
                   1196:         $result.="\"@s2texts\");\n";
                   1197:     }
                   1198:     $"=' ';
                   1199:     $result.= <<"END";
                   1200: 
1.1245    raeburn  1201: function select1${suffix}_changed() {
1.36      matthew  1202:     // Determine new choice
1.1245    raeburn  1203:     var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36      matthew  1204:     // update select2
1.1245    raeburn  1205:     var values     = select2data${suffix}[newvalue].values;
                   1206:     var texts      = select2data${suffix}[newvalue].texts;
                   1207:     var select2def = select2data${suffix}[newvalue].def;
1.36      matthew  1208:     var i;
                   1209:     // out with the old
1.1245    raeburn  1210:     $second.options.length = 0;
                   1211:     // in with the new
1.36      matthew  1212:     for (i=0;i<values.length; i++) {
                   1213:         $second.options[i] = new Option(values[i]);
1.143     matthew  1214:         $second.options[i].value = values[i];
1.36      matthew  1215:         $second.options[i].text = texts[i];
                   1216:         if (values[i] == select2def) {
                   1217:             $second.options[i].selected = true;
                   1218:         }
                   1219:     }
                   1220: }
1.824     bisitz   1221: // ]]>
1.36      matthew  1222: </script>
                   1223: END
                   1224:     # output the initial values for the selection lists
1.1245    raeburn  1225:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609     raeburn  1226:     my @order = sort(keys(%{$hashref}));
                   1227:     if (ref($menuorder) eq 'ARRAY') {
                   1228:         @order = @{$menuorder};
                   1229:     }
                   1230:     foreach my $value (@order) {
1.36      matthew  1231:         $result.="    <option value=\"$value\" ";
1.253     albertel 1232:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1233:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1234:     }
                   1235:     $result .= "</select>\n";
1.1400    raeburn  1236:     my %select2;
                   1237:     if (ref($hashref->{$firstdefault}) eq 'HASH') {
                   1238:         if (ref($hashref->{$firstdefault}->{'select2'}) eq 'HASH') {
                   1239:             %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1240:         }
                   1241:     }
1.36      matthew  1242:     $result .= $middletext;
1.1115    raeburn  1243:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1244:     if ($onchangesecond) {
                   1245:         $result .= ' onchange="'.$onchangesecond.'"';
                   1246:     }
                   1247:     $result .= ">\n";
1.36      matthew  1248:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1249:     
                   1250:     my @secondorder = sort(keys(%select2));
                   1251:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1252:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1253:     }
                   1254:     foreach my $value (@secondorder) {
1.36      matthew  1255:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1256:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1257:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1258:     }
                   1259:     $result .= "</select>\n";
                   1260:     #    return $debug;
                   1261:     return $result;
                   1262: }   #  end of sub linked_select_forms {
                   1263: 
1.45      matthew  1264: =pod
1.44      bowersj2 1265: 
1.1381    raeburn  1266: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
1.44      bowersj2 1267: 
1.112     bowersj2 1268: Returns a string corresponding to an HTML link to the given help
                   1269: $topic, where $topic corresponds to the name of a .tex file in
                   1270: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1271: spaces. 
                   1272: 
                   1273: $text will optionally be linked to the same topic, allowing you to
                   1274: link text in addition to the graphic. If you do not want to link
                   1275: text, but wish to specify one of the later parameters, pass an
                   1276: empty string. 
                   1277: 
                   1278: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1279: the link will not open a new window. If false, the link will open
                   1280: a new window using Javascript. (Default is false.) 
                   1281: 
                   1282: $width and $height are optional numerical parameters that will
                   1283: override the width and height of the popped up window, which may
1.973     raeburn  1284: be useful for certain help topics with big pictures included.
                   1285: 
                   1286: $imgid is the id of the img tag used for the help icon. This may be
                   1287: used in a javascript call to switch the image src.  See 
                   1288: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1289: 
1.1381    raeburn  1290: $links_target will optionally be set to a target (_top, _parent or _self).
                   1291: 
1.44      bowersj2 1292: =cut
                   1293: 
                   1294: sub help_open_topic {
1.1381    raeburn  1295:     my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
1.48      bowersj2 1296:     $text = "" if (not defined $text);
1.44      bowersj2 1297:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1298:     $width = 500 if (not defined $width);
1.44      bowersj2 1299:     $height = 400 if (not defined $height);
                   1300:     my $filename = $topic;
                   1301:     $filename =~ s/ /_/g;
                   1302: 
1.48      bowersj2 1303:     my $template = "";
                   1304:     my $link;
1.572     banghart 1305:     
1.159     www      1306:     $topic=~s/\W/\_/g;
1.44      bowersj2 1307: 
1.572     banghart 1308:     if (!$stayOnPage) {
1.1033    www      1309: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1310:     } elsif ($stayOnPage eq 'popup') {
                   1311:         $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 1312:     } else {
1.48      bowersj2 1313: 	$link = "/adm/help/${filename}.hlp";
                   1314:     }
                   1315: 
                   1316:     # Add the text
1.1314    raeburn  1317:     my $target = ' target="_top"';
1.1381    raeburn  1318:     if ($links_target) {
                   1319:         $target = ' target="'.$links_target.'"';
                   1320:     } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                   1321:              (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
                   1322:         $target = '';
1.1378    raeburn  1323:     }
1.1380    raeburn  1324:     if ($text ne "") {
1.763     bisitz   1325: 	$template.='<span class="LC_help_open_topic">'
1.1314    raeburn  1326:                   .'<a'.$target.' href="'.$link.'">'
1.763     bisitz   1327:                   .$text.'</a>';
1.48      bowersj2 1328:     }
                   1329: 
1.763     bisitz   1330:     # (Always) Add the graphic
1.179     matthew  1331:     my $title = &mt('Online Help');
1.667     raeburn  1332:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1333:     if ($imgid ne '') {
                   1334:         $imgid = ' id="'.$imgid.'"';
                   1335:     }
1.1314    raeburn  1336:     $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763     bisitz   1337:               .'<img src="'.$helpicon.'" border="0"'
                   1338:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1339:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1340:               .' /></a>';
                   1341:     if ($text ne "") {	
                   1342:         $template.='</span>';
                   1343:     }
1.44      bowersj2 1344:     return $template;
                   1345: 
1.106     bowersj2 1346: }
                   1347: 
                   1348: # This is a quicky function for Latex cheatsheet editing, since it 
                   1349: # appears in at least four places
                   1350: sub helpLatexCheatsheet {
1.1037    www      1351:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1352:     my $out;
1.106     bowersj2 1353:     my $addOther = '';
1.732     raeburn  1354:     if ($topic) {
1.1037    www      1355: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1356:     }
                   1357:     $out = '<span>' # Start cheatsheet
                   1358: 	  .$addOther
                   1359:           .'<span>'
1.1037    www      1360: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1361: 	  .'</span> <span>'
1.1037    www      1362: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1363: 	  .'</span>';
1.732     raeburn  1364:     unless ($not_author) {
1.1186    kruse    1365:         $out .= '<span>'
                   1366:                .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                   1367:                .'</span> <span>'
                   1368:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763     bisitz   1369: 	       .'</span>';
1.732     raeburn  1370:     }
1.763     bisitz   1371:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1372:     return $out;
1.172     www      1373: }
                   1374: 
1.430     albertel 1375: sub general_help {
                   1376:     my $helptopic='Student_Intro';
                   1377:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1378: 	$helptopic='Authoring_Intro';
1.907     raeburn  1379:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1380: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1381:     } elsif ($env{'request.role'}=~/^dc/) {
                   1382:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1383:     }
                   1384:     return $helptopic;
                   1385: }
                   1386: 
                   1387: sub update_help_link {
                   1388:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1389:     my $origurl = $ENV{'REQUEST_URI'};
                   1390:     $origurl=~s|^/~|/priv/|;
                   1391:     my $timestamp = time;
                   1392:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1393:         $$datum = &escape($$datum);
                   1394:     }
                   1395: 
                   1396:     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";
                   1397:     my $output .= <<"ENDOUTPUT";
                   1398: <script type="text/javascript">
1.824     bisitz   1399: // <![CDATA[
1.430     albertel 1400: banner_link = '$banner_link';
1.824     bisitz   1401: // ]]>
1.430     albertel 1402: </script>
                   1403: ENDOUTPUT
                   1404:     return $output;
                   1405: }
                   1406: 
                   1407: # now just updates the help link and generates a blue icon
1.193     raeburn  1408: sub help_open_menu {
1.1381    raeburn  1409:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target) 
1.552     banghart 1410: 	= @_;    
1.949     droeschl 1411:     $stayOnPage = 1;
1.430     albertel 1412:     my $output;
                   1413:     if ($component_help) {
                   1414: 	if (!$text) {
                   1415: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
1.1381    raeburn  1416: 				       $width,$height,'',$links_target);
1.430     albertel 1417: 	} else {
                   1418: 	    my $help_text;
                   1419: 	    $help_text=&unescape($topic);
                   1420: 	    $output='<table><tr><td>'.
                   1421: 		&help_open_topic($component_help,$help_text,$stayOnPage,
1.1381    raeburn  1422: 				 $width,$height,'',$links_target).'</td></tr></table>';
1.430     albertel 1423: 	}
                   1424:     }
                   1425:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1426:     return $output.$banner_link;
                   1427: }
                   1428: 
                   1429: sub top_nav_help {
1.1369    raeburn  1430:     my ($text,$linkattr) = @_;
1.436     albertel 1431:     $text = &mt($text);
1.949     droeschl 1432:     my $stay_on_page = 1;
                   1433: 
1.1168    raeburn  1434:     my ($link,$banner_link);
                   1435:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1436:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1437: 	                         : "javascript:helpMenu('open')";
                   1438:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1439:     }
1.201     raeburn  1440:     my $title = &mt('Get help');
1.1168    raeburn  1441:     if ($link) {
                   1442:         return <<"END";
1.436     albertel 1443: $banner_link
1.1369    raeburn  1444: <a href="$link" title="$title" $linkattr>$text</a>
1.436     albertel 1445: END
1.1168    raeburn  1446:     } else {
                   1447:         return '&nbsp;'.$text.'&nbsp;';
                   1448:     }
1.436     albertel 1449: }
                   1450: 
                   1451: sub help_menu_js {
1.1154    raeburn  1452:     my ($httphost) = @_;
1.949     droeschl 1453:     my $stayOnPage = 1;
1.436     albertel 1454:     my $width = 620;
                   1455:     my $height = 600;
1.430     albertel 1456:     my $helptopic=&general_help();
1.1154    raeburn  1457:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1458:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1459:     my $start_page =
                   1460:         &Apache::loncommon::start_page('Help Menu', undef,
                   1461: 				       {'frameset'    => 1,
                   1462: 					'js_ready'    => 1,
1.1154    raeburn  1463:                                         'use_absolute' => $httphost,
1.331     albertel 1464: 					'add_entries' => {
1.1168    raeburn  1465: 					    'border' => '0', 
1.579     raeburn  1466: 					    'rows'   => "110,*",},});
1.331     albertel 1467:     my $end_page =
                   1468:         &Apache::loncommon::end_page({'frameset' => 1,
                   1469: 				      'js_ready' => 1,});
                   1470: 
1.436     albertel 1471:     my $template .= <<"ENDTEMPLATE";
                   1472: <script type="text/javascript">
1.877     bisitz   1473: // <![CDATA[
1.253     albertel 1474: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1475: var banner_link = '';
1.243     raeburn  1476: function helpMenu(target) {
                   1477:     var caller = this;
                   1478:     if (target == 'open') {
                   1479:         var newWindow = null;
                   1480:         try {
1.262     albertel 1481:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1482:         }
                   1483:         catch(error) {
                   1484:             writeHelp(caller);
                   1485:             return;
                   1486:         }
                   1487:         if (newWindow) {
                   1488:             caller = newWindow;
                   1489:         }
1.193     raeburn  1490:     }
1.243     raeburn  1491:     writeHelp(caller);
                   1492:     return;
                   1493: }
                   1494: function writeHelp(caller) {
1.1168    raeburn  1495:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1496:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1497:     caller.document.close();
                   1498:     caller.focus();
1.193     raeburn  1499: }
1.877     bisitz   1500: // END LON-CAPA Internal -->
1.253     albertel 1501: // ]]>
1.436     albertel 1502: </script>
1.193     raeburn  1503: ENDTEMPLATE
                   1504:     return $template;
                   1505: }
                   1506: 
1.172     www      1507: sub help_open_bug {
                   1508:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1509:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1510:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1511:     $text = "" if (not defined $text);
                   1512: 	$stayOnPage=1;
1.184     albertel 1513:     $width = 600 if (not defined $width);
                   1514:     $height = 600 if (not defined $height);
1.172     www      1515: 
                   1516:     $topic=~s/\W+/\+/g;
                   1517:     my $link='';
                   1518:     my $template='';
1.379     albertel 1519:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1520: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1521:     if (!$stayOnPage)
                   1522:     {
                   1523: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1524:     }
                   1525:     else
                   1526:     {
                   1527: 	$link = $url;
                   1528:     }
1.1314    raeburn  1529: 
1.1382    raeburn  1530:     my $target = '_top';
                   1531:     if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                   1532:         (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
                   1533:         $target = '_blank';
1.1378    raeburn  1534:     }
1.1382    raeburn  1535: 
1.172     www      1536:     # Add the text
                   1537:     if ($text ne "")
                   1538:     {
                   1539: 	$template .= 
                   1540:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1382    raeburn  1541:   "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1542:     }
                   1543: 
                   1544:     # Add the graphic
1.179     matthew  1545:     my $title = &mt('Report a Bug');
1.215     albertel 1546:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1547:     $template .= <<"ENDTEMPLATE";
1.1382    raeburn  1548:  <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1549: ENDTEMPLATE
                   1550:     if ($text ne '') { $template.='</td></tr></table>' };
                   1551:     return $template;
                   1552: 
                   1553: }
                   1554: 
                   1555: sub help_open_faq {
                   1556:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1557:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1558:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1559:     $text = "" if (not defined $text);
                   1560: 	$stayOnPage=1;
                   1561:     $width = 350 if (not defined $width);
                   1562:     $height = 400 if (not defined $height);
                   1563: 
                   1564:     $topic=~s/\W+/\+/g;
                   1565:     my $link='';
                   1566:     my $template='';
                   1567:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1568:     if (!$stayOnPage)
                   1569:     {
                   1570: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1571:     }
                   1572:     else
                   1573:     {
                   1574: 	$link = $url;
                   1575:     }
                   1576: 
                   1577:     # Add the text
                   1578:     if ($text ne "")
                   1579:     {
                   1580: 	$template .= 
1.173     www      1581:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1582:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1583:     }
                   1584: 
                   1585:     # Add the graphic
1.179     matthew  1586:     my $title = &mt('View the FAQ');
1.215     albertel 1587:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1588:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1589:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1590: ENDTEMPLATE
                   1591:     if ($text ne '') { $template.='</td></tr></table>' };
                   1592:     return $template;
                   1593: 
1.44      bowersj2 1594: }
1.37      matthew  1595: 
1.180     matthew  1596: ###############################################################
                   1597: ###############################################################
                   1598: 
1.45      matthew  1599: =pod
                   1600: 
1.648     raeburn  1601: =item * &change_content_javascript():
1.256     matthew  1602: 
                   1603: This and the next function allow you to create small sections of an
                   1604: otherwise static HTML page that you can update on the fly with
                   1605: Javascript, even in Netscape 4.
                   1606: 
                   1607: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1608: must be written to the HTML page once. It will prove the Javascript
                   1609: function "change(name, content)". Calling the change function with the
                   1610: name of the section 
                   1611: you want to update, matching the name passed to C<changable_area>, and
                   1612: the new content you want to put in there, will put the content into
                   1613: that area.
                   1614: 
                   1615: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1616: to contain room for the original contents. You need to "make space"
                   1617: for whatever changes you wish to make, and be B<sure> to check your
                   1618: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1619: it's adequate for updating a one-line status display, but little more.
                   1620: This script will set the space to 100% width, so you only need to
                   1621: worry about height in Netscape 4.
                   1622: 
                   1623: Modern browsers are much less limiting, and if you can commit to the
                   1624: user not using Netscape 4, this feature may be used freely with
                   1625: pretty much any HTML.
                   1626: 
                   1627: =cut
                   1628: 
                   1629: sub change_content_javascript {
                   1630:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1631:     if ($env{'browser.type'} eq 'netscape' &&
                   1632: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1633: 	return (<<NETSCAPE4);
                   1634: 	function change(name, content) {
                   1635: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1636: 	    doc.open();
                   1637: 	    doc.write(content);
                   1638: 	    doc.close();
                   1639: 	}
                   1640: NETSCAPE4
                   1641:     } else {
                   1642: 	# Otherwise, we need to use semi-standards-compliant code
                   1643: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1644: 	# is really scary, and every useful browser supports it
                   1645: 	return (<<DOMBASED);
                   1646: 	function change(name, content) {
                   1647: 	    element = document.getElementById(name);
                   1648: 	    element.innerHTML = content;
                   1649: 	}
                   1650: DOMBASED
                   1651:     }
                   1652: }
                   1653: 
                   1654: =pod
                   1655: 
1.648     raeburn  1656: =item * &changable_area($name,$origContent):
1.256     matthew  1657: 
                   1658: This provides a "changable area" that can be modified on the fly via
                   1659: the Javascript code provided in C<change_content_javascript>. $name is
                   1660: the name you will use to reference the area later; do not repeat the
                   1661: same name on a given HTML page more then once. $origContent is what
                   1662: the area will originally contain, which can be left blank.
                   1663: 
                   1664: =cut
                   1665: 
                   1666: sub changable_area {
                   1667:     my ($name, $origContent) = @_;
                   1668: 
1.258     albertel 1669:     if ($env{'browser.type'} eq 'netscape' &&
                   1670: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1671: 	# If this is netscape 4, we need to use the Layer tag
                   1672: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1673:     } else {
                   1674: 	return "<span id='$name'>$origContent</span>";
                   1675:     }
                   1676: }
                   1677: 
                   1678: =pod
                   1679: 
1.648     raeburn  1680: =item * &viewport_geometry_js 
1.590     raeburn  1681: 
                   1682: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1683: 
                   1684: =cut
                   1685: 
                   1686: 
                   1687: sub viewport_geometry_js { 
                   1688:     return <<"GEOMETRY";
                   1689: var Geometry = {};
                   1690: function init_geometry() {
                   1691:     if (Geometry.init) { return };
                   1692:     Geometry.init=1;
                   1693:     if (window.innerHeight) {
                   1694:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1695:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1696:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1697:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1698:     }
                   1699:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1700:         Geometry.getViewportHeight =
                   1701:             function() { return document.documentElement.clientHeight; };
                   1702:         Geometry.getViewportWidth =
                   1703:             function() { return document.documentElement.clientWidth; };
                   1704: 
                   1705:         Geometry.getHorizontalScroll =
                   1706:             function() { return document.documentElement.scrollLeft; };
                   1707:         Geometry.getVerticalScroll =
                   1708:             function() { return document.documentElement.scrollTop; };
                   1709:     }
                   1710:     else if (document.body.clientHeight) {
                   1711:         Geometry.getViewportHeight =
                   1712:             function() { return document.body.clientHeight; };
                   1713:         Geometry.getViewportWidth =
                   1714:             function() { return document.body.clientWidth; };
                   1715:         Geometry.getHorizontalScroll =
                   1716:             function() { return document.body.scrollLeft; };
                   1717:         Geometry.getVerticalScroll =
                   1718:             function() { return document.body.scrollTop; };
                   1719:     }
                   1720: }
                   1721: 
                   1722: GEOMETRY
                   1723: }
                   1724: 
                   1725: =pod
                   1726: 
1.648     raeburn  1727: =item * &viewport_size_js()
1.590     raeburn  1728: 
                   1729: 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. 
                   1730: 
                   1731: =cut
                   1732: 
                   1733: sub viewport_size_js {
                   1734:     my $geometry = &viewport_geometry_js();
                   1735:     return <<"DIMS";
                   1736: 
                   1737: $geometry
                   1738: 
                   1739: function getViewportDims(width,height) {
                   1740:     init_geometry();
                   1741:     width.value = Geometry.getViewportWidth();
                   1742:     height.value = Geometry.getViewportHeight();
                   1743:     return;
                   1744: }
                   1745: 
                   1746: DIMS
                   1747: }
                   1748: 
                   1749: =pod
                   1750: 
1.648     raeburn  1751: =item * &resize_textarea_js()
1.565     albertel 1752: 
                   1753: emits the needed javascript to resize a textarea to be as big as possible
                   1754: 
                   1755: creates a function resize_textrea that takes two IDs first should be
                   1756: the id of the element to resize, second should be the id of a div that
                   1757: surrounds everything that comes after the textarea, this routine needs
                   1758: to be attached to the <body> for the onload and onresize events.
                   1759: 
1.648     raeburn  1760: =back
1.565     albertel 1761: 
                   1762: =cut
                   1763: 
                   1764: sub resize_textarea_js {
1.590     raeburn  1765:     my $geometry = &viewport_geometry_js();
1.565     albertel 1766:     return <<"RESIZE";
                   1767:     <script type="text/javascript">
1.824     bisitz   1768: // <![CDATA[
1.590     raeburn  1769: $geometry
1.565     albertel 1770: 
1.588     albertel 1771: function getX(element) {
                   1772:     var x = 0;
                   1773:     while (element) {
                   1774: 	x += element.offsetLeft;
                   1775: 	element = element.offsetParent;
                   1776:     }
                   1777:     return x;
                   1778: }
                   1779: function getY(element) {
                   1780:     var y = 0;
                   1781:     while (element) {
                   1782: 	y += element.offsetTop;
                   1783: 	element = element.offsetParent;
                   1784:     }
                   1785:     return y;
                   1786: }
                   1787: 
                   1788: 
1.565     albertel 1789: function resize_textarea(textarea_id,bottom_id) {
                   1790:     init_geometry();
                   1791:     var textarea        = document.getElementById(textarea_id);
                   1792:     //alert(textarea);
                   1793: 
1.588     albertel 1794:     var textarea_top    = getY(textarea);
1.565     albertel 1795:     var textarea_height = textarea.offsetHeight;
                   1796:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1797:     var bottom_top      = getY(bottom);
1.565     albertel 1798:     var bottom_height   = bottom.offsetHeight;
                   1799:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1800:     var fudge           = 23;
1.565     albertel 1801:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1802:     if (new_height < 300) {
                   1803: 	new_height = 300;
                   1804:     }
                   1805:     textarea.style.height=new_height+'px';
                   1806: }
1.824     bisitz   1807: // ]]>
1.565     albertel 1808: </script>
                   1809: RESIZE
                   1810: 
                   1811: }
                   1812: 
1.1205    golterma 1813: sub colorfuleditor_js {
1.1248    raeburn  1814:     my $browse_or_search;
                   1815:     my $respath;
                   1816:     my ($cnum,$cdom) = &crsauthor_url();
                   1817:     if ($cnum) {
                   1818:         $respath = "/res/$cdom/$cnum/";
                   1819:         my %js_lt = &Apache::lonlocal::texthash(
                   1820:             sunm => 'Sub-directory name',
                   1821:             save => 'Save page to make this permanent',
                   1822:         );
                   1823:         &js_escape(\%js_lt);
1.1400    raeburn  1824:         my $showfile_js = &show_crsfiles_js();
1.1248    raeburn  1825:         $browse_or_search = <<"END";
                   1826: 
1.1400    raeburn  1827:     $showfile_js
                   1828: 
1.1248    raeburn  1829:     function toggleChooser(form,element,titleid,only,search) {
                   1830:         var disp = 'none';
                   1831:         if (document.getElementById('chooser_'+element)) {
                   1832:             var curr = document.getElementById('chooser_'+element).style.display;
                   1833:             if (curr == 'none') {
                   1834:                 disp='inline';
                   1835:                 if (form.elements['chooser_'+element].length) {
                   1836:                     for (var i=0; i<form.elements['chooser_'+element].length; i++) {
                   1837:                         form.elements['chooser_'+element][i].checked = false;
                   1838:                     }
                   1839:                 }
                   1840:                 toggleResImport(form,element);
                   1841:             }
                   1842:             document.getElementById('chooser_'+element).style.display = disp;
1.1400    raeburn  1843:             var dirsel = '';
                   1844:             var filesel = '';
                   1845:             if (document.getElementById('chooser_'+element+'_crsres')) {
                   1846:                 var currcrsres = document.getElementById('chooser_'+element+'_crsres').style.display;
                   1847:                 if (currcrsres == 'none') {
                   1848:                     dirsel = 'coursepath_'+element;
                   1849:                     var filesel = 'coursefile_'+element;
                   1850:                     var include;
                   1851:                     if (document.getElementById('crsres_include_'+element)) {
                   1852:                         include = document.getElementById('crsres_include_'+element).value;
                   1853:                     }
1.1402    raeburn  1854:                     populateCrsSelects(form,dirsel,filesel,1,include,1,0,1,1,0);
1.1400    raeburn  1855:                 }
                   1856:             }
                   1857:             if (document.getElementById('chooser_'+element+'_upload')) {
                   1858:                 var currcrsupload = document.getElementById('chooser_'+element+'_upload').style.display;
                   1859:                 if (currcrsupload == 'none') {
                   1860:                     dirsel = 'crsauthorpath_'+element;
                   1861:                     filesel = '';
1.1402    raeburn  1862:                     populateCrsSelects(form,dirsel,filesel,0,'',1,0,1,0,1);
1.1400    raeburn  1863:                 }
                   1864:             }
1.1248    raeburn  1865:         }
                   1866:     }
                   1867: 
1.1400    raeburn  1868:     function toggleCrsFile(form,element) {
1.1248    raeburn  1869:         if (document.getElementById('chooser_'+element+'_crsres')) {
                   1870:             var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
                   1871:             if (curr == 'none') {
1.1400    raeburn  1872:                 if (document.getElementById('coursepath_'+element)) {
                   1873:                     var numdirs;
                   1874:                     if (document.getElementById('coursepath_'+element).length) {
                   1875:                         numdirs = document.getElementById('coursepath_'+element).length;
                   1876:                     }
1.1402    raeburn  1877:                     if ((document.getElementById('hascrsres_'+element)) &&
                   1878:                         (document.getElementById('nocrsres_'+element))) {
                   1879:                         if (numdirs) {
                   1880:                             document.getElementById('hascrsres_'+element).style.display='inline-block';
                   1881:                             document.getElementById('nocrsres_'+element).style.display='none';
                   1882:                         } else {
                   1883:                             document.getElementById('hascrsres_'+element).style.display='none';
                   1884:                             document.getElementById('nocrsres_'+element).style.display='inline-block';
                   1885:                         }
                   1886:                     }
1.1248    raeburn  1887:                     form.elements['coursepath_'+element].selectedIndex = 0;
                   1888:                     if (numdirs > 1) {
1.1400    raeburn  1889:                         var selelem = form.elements['coursefile_'+element];
                   1890:                         var i, len = selelem.options.length -1;
                   1891:                         if (len >=0) {
                   1892:                             for (i = len; i >= 0; i--) {
                   1893:                                 selelem.remove(i);
                   1894:                             }
                   1895:                             selelem.options[0] = new Option('','');
                   1896:                         }
1.1248    raeburn  1897:                     }
                   1898:                 }
1.1400    raeburn  1899:             }
1.1248    raeburn  1900:             document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
                   1901:         }
                   1902:         if (document.getElementById('chooser_'+element+'_upload')) {
                   1903:             document.getElementById('chooser_'+element+'_upload').style.display = 'none';
                   1904:             if (document.getElementById('uploadcrsres_'+element)) {
                   1905:                 document.getElementById('uploadcrsres_'+element).value = '';
                   1906:             }
                   1907:         }
                   1908:         return;
                   1909:     }
                   1910: 
1.1400    raeburn  1911:     function toggleCrsUpload(form,element) {
1.1248    raeburn  1912:         if (document.getElementById('chooser_'+element+'_crsres')) {
                   1913:             document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
                   1914:         }
                   1915:         if (document.getElementById('chooser_'+element+'_upload')) {
                   1916:             var curr = document.getElementById('chooser_'+element+'_upload').style.display;
                   1917:             if (curr == 'none') {
1.1400    raeburn  1918:                 form.elements['newsubdir_'+element][0].checked = true;
                   1919:                 toggleNewsubdir(form,element);
                   1920:                 document.getElementById('chooser_'+element+'_upload').style.display = 'block';
                   1921:                 if (document.getElementById('uploadcrsres_'+element)) {
                   1922:                     document.getElementById('uploadcrsres_'+element).value = '';
1.1248    raeburn  1923:                 }
                   1924:             }
                   1925:         }
                   1926:         return;
                   1927:     }
                   1928: 
                   1929:     function toggleResImport(form,element) {
                   1930:         var choices = new Array('crsres','upload');
                   1931:         for (var i=0; i<choices.length; i++) {
                   1932:             if (document.getElementById('chooser_'+element+'_'+choices[i])) {
                   1933:                 document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
                   1934:             }
                   1935:         }
                   1936:     }
                   1937: 
                   1938:     function toggleNewsubdir(form,element) {
                   1939:         var newsub = form.elements['newsubdir_'+element];
                   1940:         if (newsub) {
                   1941:             if (newsub.length) {
                   1942:                 for (var j=0; j<newsub.length; j++) {
                   1943:                     if (newsub[j].checked) {
                   1944:                         if (document.getElementById('newsubdirname_'+element)) {
                   1945:                             if (newsub[j].value == '1') {
                   1946:                                 document.getElementById('newsubdirname_'+element).type = "text";
                   1947:                                 if (document.getElementById('newsubdir_'+element)) {
                   1948:                                     document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
                   1949:                                 }
                   1950:                             } else {
                   1951:                                 document.getElementById('newsubdirname_'+element).type = "hidden";
                   1952:                                 document.getElementById('newsubdirname_'+element).value = "";
                   1953:                                 document.getElementById('newsubdir_'+element).innerHTML = "";
                   1954:                             }
                   1955:                         }
                   1956:                         break; 
                   1957:                     }
                   1958:                 }
                   1959:             }
                   1960:         }
                   1961:     }
                   1962: 
                   1963:     function updateCrsFile(form,element) {
                   1964:         var directory = form.elements['coursepath_'+element];
                   1965:         var filename = form.elements['coursefile_'+element];
                   1966:         var path = directory.options[directory.selectedIndex].value;
                   1967:         var file = filename.options[filename.selectedIndex].value;
1.1400    raeburn  1968:         if (file != '') {
                   1969:             form.elements[element].value = '$respath';
                   1970:             if (path == '/') {
                   1971:                 form.elements[element].value += file;
                   1972:             } else {
                   1973:                 form.elements[element].value += path+'/'+file;
                   1974:             }
                   1975:             unClean();
                   1976:             if (document.getElementById('previewimg_'+element)) {
                   1977:                 document.getElementById('previewimg_'+element).src = form.elements[element].value;
                   1978:                 var newsrc = document.getElementById('previewimg_'+element).src; 
                   1979:             }
                   1980:             if (document.getElementById('showimg_'+element)) {
                   1981:                 document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
                   1982:             }
1.1248    raeburn  1983:         }
                   1984:         toggleChooser(form,element);
                   1985:         return;
                   1986:     }
                   1987: 
                   1988:     function uploadDone(suffix,name) {
                   1989:         if (name) {
                   1990: 	    document.forms["lonhomework"].elements[suffix].value = name;
                   1991:             unClean();
                   1992:             toggleChooser(document.forms["lonhomework"],suffix);
                   1993:         }
                   1994:     }
                   1995: 
                   1996: \$(document).ready(function(){
                   1997: 
                   1998:     \$(document).delegate('form :submit', 'click', function( event ) {
                   1999:         if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
                   2000:             var buttonId = this.id;
                   2001:             var suffix = buttonId.toString();
                   2002:             suffix = suffix.replace(/^crsupload_/,'');
                   2003:             event.preventDefault();
                   2004:             document.lonhomework.target = 'crsupload_target_'+suffix;
                   2005:             document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
                   2006:             \$(this.form).submit();
                   2007:             document.lonhomework.target = '';
                   2008:             if (document.getElementById('crsuploadto_'+suffix)) {
                   2009:                 document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
                   2010:             }
                   2011:             return false;
                   2012:         }
                   2013:     });
                   2014: });
                   2015: END
                   2016:     }
1.1205    golterma 2017:     return <<"COLORFULEDIT"
                   2018: <script type="text/javascript">
                   2019: // <![CDATA[>
                   2020:     function fold_box(curDepth, lastresource){
                   2021: 
                   2022:     // we need a list because there can be several blocks you need to fold in one tag
                   2023:         var block = document.getElementsByName('foldblock_'+curDepth);
                   2024:     // but there is only one folding button per tag
                   2025:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   2026: 
                   2027:         if(block.item(0).style.display == 'none'){
                   2028: 
                   2029:             foldbutton.value = '@{[&mt("Hide")]}';
                   2030:             for (i = 0; i < block.length; i++){
                   2031:                 block.item(i).style.display = '';
                   2032:             }
                   2033:         }else{
                   2034: 
                   2035:             foldbutton.value = '@{[&mt("Show")]}';
                   2036:             for (i = 0; i < block.length; i++){
                   2037:                 // block.item(i).style.visibility = 'collapse';
                   2038:                 block.item(i).style.display = 'none';
                   2039:             }
                   2040:         };
                   2041:         saveState(lastresource);
                   2042:     }
                   2043: 
                   2044:     function saveState (lastresource) {
                   2045: 
                   2046:         var tag_list = getTagList();
                   2047:         if(tag_list != null){
                   2048:             var timestamp = new Date().getTime();
                   2049:             var key = lastresource;
                   2050: 
                   2051:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   2052:             // starting with timestamp
                   2053:             var value = timestamp+';';
                   2054: 
                   2055:             // building the list of key-value pairs
                   2056:             for(var i = 0; i < tag_list.length; i++){
                   2057:                 value += tag_list[i]+',';
                   2058:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   2059:             }
                   2060: 
                   2061:             // only iterate whole storage if nothing to override
                   2062:             if(localStorage.getItem(key) == null){        
                   2063: 
                   2064:                 // prevent storage from growing large
                   2065:                 if(localStorage.length > 50){
                   2066:                     var regex_getTimestamp = /^(?:\d)+;/;
                   2067:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   2068:                     var oldest_key;
                   2069:                     
                   2070:                     for(var i = 1; i < localStorage.length; i++){
                   2071:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   2072:                             oldest_key = localStorage.key(i);
                   2073:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   2074:                         }
                   2075:                     }
                   2076:                     localStorage.removeItem(oldest_key);
                   2077:                 }
                   2078:             }
                   2079:             localStorage.setItem(key,value);
                   2080:         }
                   2081:     }
                   2082: 
                   2083:     // restore folding status of blocks (on page load)
                   2084:     function restoreState (lastresource) {
                   2085:         if(localStorage.getItem(lastresource) != null){
                   2086:             var key = lastresource;
                   2087:             var value = localStorage.getItem(key);
                   2088:             var regex_delTimestamp = /^\d+;/;
                   2089: 
                   2090:             value.replace(regex_delTimestamp, '');
                   2091: 
                   2092:             var valueArr = value.split(';');
                   2093:             var pairs;
                   2094:             var elements;
                   2095:             for (var i = 0; i < valueArr.length; i++){
                   2096:                 pairs = valueArr[i].split(',');
                   2097:                 elements = document.getElementsByName(pairs[0]);
                   2098: 
                   2099:                 for (var j = 0; j < elements.length; j++){  
                   2100:                     elements[j].style.display = pairs[1];
                   2101:                     if (pairs[1] == "none"){
                   2102:                         var regex_id = /([_\\d]+)\$/;
                   2103:                         regex_id.exec(pairs[0]);
                   2104:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   2105:                     }
                   2106:                 }
                   2107:             }
                   2108:         }
                   2109:     }
                   2110: 
                   2111:     function getTagList () {
                   2112:         
                   2113:         var stringToSearch = document.lonhomework.innerHTML;
                   2114: 
                   2115:         var ret = new Array();
                   2116:         var regex_findBlock = /(foldblock_.*?)"/g;
                   2117:         var tag_list = stringToSearch.match(regex_findBlock);
                   2118: 
                   2119:         if(tag_list != null){
                   2120:             for(var i = 0; i < tag_list.length; i++){            
                   2121:                 ret.push(tag_list[i].replace(/"/, ''));
                   2122:             }
                   2123:         }
                   2124:         return ret;
                   2125:     }
                   2126: 
                   2127:     function saveScrollPosition (resource) {
                   2128:         var tag_list = getTagList();
                   2129: 
                   2130:         // we dont always want to jump to the first block
                   2131:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   2132:         if(\$(window).scrollTop() > 170){
                   2133:             if(tag_list != null){
                   2134:                 var result;
                   2135:                 for(var i = 0; i < tag_list.length; i++){
                   2136:                     if(isElementInViewport(tag_list[i])){
                   2137:                         result += tag_list[i]+';';
                   2138:                     }
                   2139:                 }
                   2140:                 sessionStorage.setItem('anchor_'+resource, result);
                   2141:             }
                   2142:         } else {
                   2143:             // we dont need to save zero, just delete the item to leave everything tidy
                   2144:             sessionStorage.removeItem('anchor_'+resource);
                   2145:         }
                   2146:     }
                   2147: 
                   2148:     function restoreScrollPosition(resource){
                   2149: 
                   2150:         var elem = sessionStorage.getItem('anchor_'+resource);
                   2151:         if(elem != null){
                   2152:             var tag_list = elem.split(';');
                   2153:             var elem_list;
                   2154: 
                   2155:             for(var i = 0; i < tag_list.length; i++){
                   2156:                 elem_list = document.getElementsByName(tag_list[i]);
                   2157:                 
                   2158:                 if(elem_list.length > 0){
                   2159:                     elem = elem_list[0];
                   2160:                     break;
                   2161:                 }
                   2162:             }
                   2163:             elem.scrollIntoView();
                   2164:         }
                   2165:     }
                   2166: 
                   2167:     function isElementInViewport(el) {
                   2168: 
                   2169:         // change to last element instead of first
                   2170:         var elem = document.getElementsByName(el);
                   2171:         var rect = elem[0].getBoundingClientRect();
                   2172: 
                   2173:         return (
                   2174:             rect.top >= 0 &&
                   2175:             rect.left >= 0 &&
                   2176:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   2177:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   2178:         );
                   2179:     }
                   2180:     
                   2181:     function autosize(depth){
                   2182:         var cmInst = window['cm'+depth];
                   2183:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   2184: 
                   2185:         // is fixed size, switching to dynamic
                   2186:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   2187:             cmInst.setSize("","auto");
                   2188:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   2189:             sessionStorage.setItem("autosized_"+depth, "yes");
                   2190: 
                   2191:         // is dynamic size, switching to fixed
                   2192:         } else {
                   2193:             cmInst.setSize("","300px");
                   2194:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   2195:             sessionStorage.removeItem("autosized_"+depth);
                   2196:         }
                   2197:     }
                   2198: 
1.1248    raeburn  2199: $browse_or_search
1.1205    golterma 2200: 
                   2201: // ]]>
                   2202: </script>
                   2203: COLORFULEDIT
                   2204: }
                   2205: 
                   2206: sub xmleditor_js {
                   2207:     return <<XMLEDIT
                   2208: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   2209: <script type="text/javascript">
                   2210: // <![CDATA[>
                   2211: 
                   2212:     function saveScrollPosition (resource) {
                   2213: 
                   2214:         var scrollPos = \$(window).scrollTop();
                   2215:         sessionStorage.setItem(resource,scrollPos);
                   2216:     }
                   2217: 
                   2218:     function restoreScrollPosition(resource){
                   2219: 
                   2220:         var scrollPos = sessionStorage.getItem(resource);
                   2221:         \$(window).scrollTop(scrollPos);
                   2222:     }
                   2223: 
                   2224:     // unless internet explorer
                   2225:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   2226: 
                   2227:         \$(document).ready(function() {
                   2228:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   2229:         });
                   2230:     }
                   2231: 
                   2232:     // inserts text at cursor position into codemirror (xml editor only)
                   2233:     function insertText(text){
                   2234:         cm.focus();
                   2235:         var curPos = cm.getCursor();
                   2236:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   2237:     }
                   2238: // ]]>
                   2239: </script>
                   2240: XMLEDIT
                   2241: }
                   2242: 
                   2243: sub insert_folding_button {
                   2244:     my $curDepth = $Apache::lonxml::curdepth;
                   2245:     my $lastresource = $env{'request.ambiguous'};
                   2246: 
                   2247:     return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
                   2248:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2249: }
                   2250: 
1.1248    raeburn  2251: sub crsauthor_url {
                   2252:     my ($url) = @_;
                   2253:     if ($url eq '') {
                   2254:         $url = $ENV{'REQUEST_URI'};
                   2255:     }
                   2256:     my ($cnum,$cdom);
                   2257:     if ($env{'request.course.id'}) {
                   2258:         my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
                   2259:         if ($audom ne '' && $auname ne '') {
                   2260:             if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
                   2261:                 ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
                   2262:                 $cnum = $auname;
                   2263:                 $cdom = $audom;
                   2264:             }
                   2265:         }
                   2266:     }
                   2267:     return ($cnum,$cdom);
                   2268: }
                   2269: 
                   2270: sub import_crsauthor_form {
1.1400    raeburn  2271:     my ($firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248    raeburn  2272:     return (0) unless ($env{'request.course.id'});
                   2273:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2274:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2275:     my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   2276:     return (0) unless (($cnum ne '') && ($cdom ne ''));
                   2277:     my @ids=&Apache::lonnet::current_machine_ids();
1.1400    raeburn  2278:     my ($output,$is_home,$toppath,%subdirs,%files,%selimport_menus,$include,$exclude);
1.1402    raeburn  2279: 
1.1248    raeburn  2280:     if (grep(/^\Q$crshome\E$/,@ids)) {
                   2281:         $is_home = 1;
                   2282:     }
1.1400    raeburn  2283:     $toppath = "/priv/$cdom/$cnum";
                   2284:     my $nonemptydir = 1;
                   2285:     my $js_only;
                   2286:     if ($only) {
                   2287:         map { $include->{$_} = 1; } split(/\s*,\s*/,$only);
                   2288:         $js_only = join(',',map { &js_escape($_); } sort(keys(%{$include})));
                   2289:     }
                   2290:     $exclude = &Apache::lonnet::priv_exclude();
1.1402    raeburn  2291:     &Apache::lonnet::recursedirs($is_home,1,$include,$exclude,1,0,$toppath,'',\%subdirs,\%files);
1.1400    raeburn  2292:     my $numdirs = scalar(keys(%files));
1.1248    raeburn  2293:     my %lt = &Apache::lonlocal::texthash (
                   2294:         fnam => 'Filename',
                   2295:         dire => 'Directory',
1.1400    raeburn  2296:         se   => 'Select',
1.1248    raeburn  2297:     );
1.1402    raeburn  2298:     $output = $lt{'dire'}.':&nbsp;'.
1.1400    raeburn  2299:               '<select id="'.$firstselectname.'" name="'.$firstselectname.'" '.
1.1402    raeburn  2300:               'onchange="populateCrsSelects(this.form,'."'$firstselectname','$secondselectname',1,'$js_only',0,1,0,0,0".');">'.
1.1400    raeburn  2301:               '<option value="" selected="selected">'.$lt{'se'}.'</option>';
1.1402    raeburn  2302:     if ($files{'/'}) {
                   2303:         $output .= '<option value="/">/</option>'."\n";
                   2304:     }
1.1400    raeburn  2305:     foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
1.1402    raeburn  2306:         next if ($key eq '/');
1.1400    raeburn  2307:         $output .= '<option value="'.$key.'">'.$key.'</option>'."\n";
                   2308:     }
                   2309:     $output .= '</select><br />'."\n".
1.1402    raeburn  2310:                $lt{'fnam'}.':&nbsp;<select id="'.$secondselectname.'" name="'.$secondselectname.'">'."\n".
1.1400    raeburn  2311:                '<option value="" selected="selected"></option>'."\n".
1.1402    raeburn  2312:                '</select>'."\n".
                   2313:                '<input type="hidden" id="crsres_include_'.$suffix.'" value="'.$only.'" />';
1.1400    raeburn  2314:     return ($numdirs,$output);
                   2315: }
                   2316: 
                   2317: sub show_crsfiles_js {
                   2318:     my $excluderef = &Apache::lonnet::priv_exclude();
                   2319:     my $se = &js_escape(&mt('Select'));
                   2320:     my $exclude;
                   2321:     if (ref($excluderef) eq 'HASH') {
                   2322:         $exclude = join(',', map { &js_escape($_); } sort(keys(%{$excluderef})));
                   2323:     }
                   2324:     my $js = <<"END";
                   2325: 
                   2326: 
1.1402    raeburn  2327:     function populateCrsSelects (form,dirsel,filesel,exc,include,setdir,setfile,recurse,nonemptydir,addtopdir) {
1.1400    raeburn  2328:         var relpath = '';
                   2329:         if ((setfile) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
                   2330:             var currdir = form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value;
                   2331:             if (currdir == '') {
                   2332:                 if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                   2333:                     selelem = form.elements[filesel];
                   2334:                     var j, numfiles = selelem.options.length -1;
                   2335:                     if (numfiles >=0) {
                   2336:                         for (j = numfiles; j >= 0; j--) {
                   2337:                             selelem.remove(j);
                   2338:                         }
                   2339:                     }
                   2340:                     if (selelem.options.length == 0) {
                   2341:                         selelem.options[selelem.options.length] = new Option('','');
                   2342:                         selelem.selectedIndex = 0;
1.1248    raeburn  2343:                     }
                   2344:                 }
1.1400    raeburn  2345:                 return;
                   2346:             } else {
                   2347:                 relpath = encodeURIComponent(form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value);
1.1248    raeburn  2348:             }
                   2349:         }
1.1400    raeburn  2350:         var http = new XMLHttpRequest();
                   2351:         var url = "/adm/courseauthor";
                   2352:         var crsrole = "$env{'request.role'}";
                   2353:         var exclude = '';
                   2354:         if (exc) {
                   2355:             exclude = '$exclude';
                   2356:         }
1.1402    raeburn  2357:         var params = "role=course&files=1&rec="+recurse+"&nonempty="+nonemptydir+"&exc="+exclude+"&inc="+include+"&addtop="+addtopdir+"&path="+relpath;
1.1400    raeburn  2358:         http.open("POST", url, true);
                   2359:         http.setRequestHeader("Content-type", "application/x-www-form-urlencoded");
                   2360:         http.onreadystatechange = function() {
                   2361:             if (http.readyState == 4 && http.status == 200) {
                   2362:                 var data = JSON.parse(http.responseText);
                   2363:                 var selelem;
                   2364:                 if ((setdir) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
                   2365:                     if (Array.isArray(data.dirs)) {
                   2366:                         selelem = form.elements[dirsel];
                   2367:                         var i, numdirs = selelem.options.length -1;
                   2368:                         if (numdirs >=0) {
                   2369:                             for (i = numdirs; i >= 0; i--) {
                   2370:                                 selelem.remove(i);
                   2371:                             }
                   2372:                         }
                   2373:                         var len = data.dirs.length;
                   2374:                         if (len) {
1.1402    raeburn  2375:                             selelem.options[selelem.options.length] = new Option('$se','');
1.1400    raeburn  2376:                             var j;
                   2377:                             for (j = 0; j < len; j++) {
                   2378:                                 selelem.options[selelem.options.length] = new Option(data.dirs[j],data.dirs[j]);
                   2379:                             }
                   2380:                             selelem.selectedIndex = 0;
                   2381:                         }
                   2382:                         if (!setfile) {
                   2383:                             if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                   2384:                                 selelem = form.elements[filesel];
                   2385:                                 var j, numfiles = selelem.options.length -1;
                   2386:                                 if (numfiles >=0) {
                   2387:                                     for (j = numfiles; j >= 0; j--) {
                   2388:                                         selelem.remove(j);
                   2389:                                     }
                   2390:                                 }
                   2391:                                 if (selelem.options.length == 0) {
                   2392:                                     selelem.options[selelem.options.length] = new Option('','');
                   2393:                                     selelem.selectedIndex = 0;
                   2394:                                 }
                   2395:                             }
                   2396:                         }
                   2397:                     }
                   2398:                 }
                   2399:                 if ((setfile) && (filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                   2400:                     selelem = form.elements[filesel];
                   2401:                     var i, numfiles = selelem.options.length -1;
                   2402:                     if (numfiles >=0) {
                   2403:                         for (i = numfiles; i >= 0; i--) {
                   2404:                             selelem.remove(i);
                   2405:                         }
                   2406:                     }
                   2407:                     var x;
                   2408:                     for (x in data.files) {
                   2409:                         if (Array.isArray(data.files[x])) {
                   2410:                             if (data.files[x].length > 1) {
                   2411:                                 selelem.options[selelem.options.length] = new Option('$se','');
                   2412:                             }
                   2413:                             var len = data.files[x].length;
                   2414:                             if (len) {
                   2415:                                 var k;
                   2416:                                 for (k = 0; k < len; k++) {
                   2417:                                     selelem.options[selelem.options.length] = new Option(data.files[x][k],data.files[x][k]);
                   2418:                                 }
                   2419:                                 selelem.selectedIndex = 0;
                   2420:                             }
                   2421:                         }
                   2422:                     }
                   2423:                     if (selelem.options.length == 0) {
                   2424:                         selelem.options[selelem.options.length] = new Option('','');
                   2425:                         selelem.selectedIndex = 0;
                   2426:                     }
1.1248    raeburn  2427:                 }
                   2428:             }
                   2429:         }
1.1400    raeburn  2430:         http.send(params);
1.1248    raeburn  2431:     }
1.1400    raeburn  2432: END
1.1248    raeburn  2433: }
                   2434: 
1.565     albertel 2435: =pod
                   2436: 
1.256     matthew  2437: =head1 Excel and CSV file utility routines
                   2438: 
                   2439: =cut
                   2440: 
                   2441: ###############################################################
                   2442: ###############################################################
                   2443: 
                   2444: =pod
                   2445: 
1.1162    raeburn  2446: =over 4
                   2447: 
1.648     raeburn  2448: =item * &csv_translate($text) 
1.37      matthew  2449: 
1.185     www      2450: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2451: format.
                   2452: 
                   2453: =cut
                   2454: 
1.180     matthew  2455: ###############################################################
                   2456: ###############################################################
1.37      matthew  2457: sub csv_translate {
                   2458:     my $text = shift;
                   2459:     $text =~ s/\"/\"\"/g;
1.209     albertel 2460:     $text =~ s/\n/ /g;
1.37      matthew  2461:     return $text;
                   2462: }
1.180     matthew  2463: 
                   2464: ###############################################################
                   2465: ###############################################################
                   2466: 
                   2467: =pod
                   2468: 
1.648     raeburn  2469: =item * &define_excel_formats()
1.180     matthew  2470: 
                   2471: Define some commonly used Excel cell formats.
                   2472: 
                   2473: Currently supported formats:
                   2474: 
                   2475: =over 4
                   2476: 
                   2477: =item header
                   2478: 
                   2479: =item bold
                   2480: 
                   2481: =item h1
                   2482: 
                   2483: =item h2
                   2484: 
                   2485: =item h3
                   2486: 
1.256     matthew  2487: =item h4
                   2488: 
                   2489: =item i
                   2490: 
1.180     matthew  2491: =item date
                   2492: 
                   2493: =back
                   2494: 
                   2495: Inputs: $workbook
                   2496: 
                   2497: Returns: $format, a hash reference.
                   2498: 
1.1057    foxr     2499: 
1.180     matthew  2500: =cut
                   2501: 
                   2502: ###############################################################
                   2503: ###############################################################
                   2504: sub define_excel_formats {
                   2505:     my ($workbook) = @_;
                   2506:     my $format;
                   2507:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2508:                                                 bottom    => 1,
                   2509:                                                 align     => 'center');
                   2510:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2511:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2512:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2513:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2514:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2515:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2516:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2517:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2518:     return $format;
                   2519: }
                   2520: 
                   2521: ###############################################################
                   2522: ###############################################################
1.113     bowersj2 2523: 
                   2524: =pod
                   2525: 
1.648     raeburn  2526: =item * &create_workbook()
1.255     matthew  2527: 
                   2528: Create an Excel worksheet.  If it fails, output message on the
                   2529: request object and return undefs.
                   2530: 
                   2531: Inputs: Apache request object
                   2532: 
                   2533: Returns (undef) on failure, 
                   2534:     Excel worksheet object, scalar with filename, and formats 
                   2535:     from &Apache::loncommon::define_excel_formats on success
                   2536: 
                   2537: =cut
                   2538: 
                   2539: ###############################################################
                   2540: ###############################################################
                   2541: sub create_workbook {
                   2542:     my ($r) = @_;
                   2543:         #
                   2544:     # Create the excel spreadsheet
                   2545:     my $filename = '/prtspool/'.
1.258     albertel 2546:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2547:         time.'_'.rand(1000000000).'.xls';
                   2548:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2549:     if (! defined($workbook)) {
                   2550:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2551:         $r->print(
                   2552:             '<p class="LC_error">'
                   2553:            .&mt('Problems occurred in creating the new Excel file.')
                   2554:            .' '.&mt('This error has been logged.')
                   2555:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2556:            .'</p>'
                   2557:         );
1.255     matthew  2558:         return (undef);
                   2559:     }
                   2560:     #
1.1014    foxr     2561:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2562:     #
                   2563:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2564:     return ($workbook,$filename,$format);
                   2565: }
                   2566: 
                   2567: ###############################################################
                   2568: ###############################################################
                   2569: 
                   2570: =pod
                   2571: 
1.648     raeburn  2572: =item * &create_text_file()
1.113     bowersj2 2573: 
1.542     raeburn  2574: Create a file to write to and eventually make available to the user.
1.256     matthew  2575: If file creation fails, outputs an error message on the request object and 
                   2576: return undefs.
1.113     bowersj2 2577: 
1.256     matthew  2578: Inputs: Apache request object, and file suffix
1.113     bowersj2 2579: 
1.256     matthew  2580: Returns (undef) on failure, 
                   2581:     Filehandle and filename on success.
1.113     bowersj2 2582: 
                   2583: =cut
                   2584: 
1.256     matthew  2585: ###############################################################
                   2586: ###############################################################
                   2587: sub create_text_file {
                   2588:     my ($r,$suffix) = @_;
                   2589:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2590:     my $fh;
                   2591:     my $filename = '/prtspool/'.
1.258     albertel 2592:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2593:         time.'_'.rand(1000000000).'.'.$suffix;
                   2594:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2595:     if (! defined($fh)) {
                   2596:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2597:         $r->print(
                   2598:             '<p class="LC_error">'
                   2599:            .&mt('Problems occurred in creating the output file.')
                   2600:            .' '.&mt('This error has been logged.')
                   2601:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2602:            .'</p>'
                   2603:         );
1.113     bowersj2 2604:     }
1.256     matthew  2605:     return ($fh,$filename)
1.113     bowersj2 2606: }
                   2607: 
                   2608: 
1.256     matthew  2609: =pod 
1.113     bowersj2 2610: 
                   2611: =back
                   2612: 
                   2613: =cut
1.37      matthew  2614: 
                   2615: ###############################################################
1.33      matthew  2616: ##        Home server <option> list generating code          ##
                   2617: ###############################################################
1.35      matthew  2618: 
1.169     www      2619: # ------------------------------------------
                   2620: 
                   2621: sub domain_select {
1.1289    raeburn  2622:     my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
                   2623:     my @possdoms;
                   2624:     if (ref($incdoms) eq 'ARRAY') {
                   2625:         @possdoms = @{$incdoms};
                   2626:     } else {
                   2627:         @possdoms = &Apache::lonnet::all_domains();
                   2628:     }
                   2629: 
1.169     www      2630:     my %domains=map { 
1.514     albertel 2631: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.1289    raeburn  2632:     } @possdoms;
                   2633: 
                   2634:     if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
                   2635:         foreach my $dom (@{$excdoms}) {
                   2636:             delete($domains{$dom});
                   2637:         }
                   2638:     }
                   2639: 
1.169     www      2640:     if ($multiple) {
                   2641: 	$domains{''}=&mt('Any domain');
1.550     albertel 2642: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2643: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2644:     } else {
1.550     albertel 2645: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2646: 	return &select_form($name,$value,\%domains);
1.169     www      2647:     }
                   2648: }
                   2649: 
1.282     albertel 2650: #-------------------------------------------
                   2651: 
                   2652: =pod
                   2653: 
1.519     raeburn  2654: =head1 Routines for form select boxes
                   2655: 
                   2656: =over 4
                   2657: 
1.648     raeburn  2658: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2659: 
                   2660: Returns a string containing a <select> element int multiple mode
                   2661: 
                   2662: 
                   2663: Args:
                   2664:   $name - name of the <select> element
1.506     raeburn  2665:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2666:   $size - number of rows long the select element is
1.283     albertel 2667:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2668:           (shown text should already have been &mt())
1.506     raeburn  2669:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2670: 
1.282     albertel 2671: =cut
                   2672: 
                   2673: #-------------------------------------------
1.169     www      2674: sub multiple_select_form {
1.284     albertel 2675:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2676:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2677:     my $output='';
1.191     matthew  2678:     if (! defined($size)) {
                   2679:         $size = 4;
1.283     albertel 2680:         if (scalar(keys(%$hash))<4) {
                   2681:             $size = scalar(keys(%$hash));
1.191     matthew  2682:         }
                   2683:     }
1.734     bisitz   2684:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2685:     my @order;
1.506     raeburn  2686:     if (ref($order) eq 'ARRAY')  {
                   2687:         @order = @{$order};
                   2688:     } else {
                   2689:         @order = sort(keys(%$hash));
1.501     banghart 2690:     }
                   2691:     if (exists($$hash{'select_form_order'})) {
                   2692:         @order = @{$$hash{'select_form_order'}};
                   2693:     }
                   2694:         
1.284     albertel 2695:     foreach my $key (@order) {
1.356     albertel 2696:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2697:         $output.='selected="selected" ' if ($selected{$key});
                   2698:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2699:     }
                   2700:     $output.="</select>\n";
                   2701:     return $output;
                   2702: }
                   2703: 
1.88      www      2704: #-------------------------------------------
                   2705: 
                   2706: =pod
                   2707: 
1.1254    raeburn  2708: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88      www      2709: 
                   2710: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2711: allow a user to select options from a ref to a hash containing:
                   2712: option_name => displayed text. An optional $onchange can include
1.1254    raeburn  2713: a javascript onchange item, e.g., onchange="this.form.submit();".
                   2714: An optional arg -- $readonly -- if true will cause the select form
                   2715: to be disabled, e.g., for the case where an instructor has a section-
                   2716: specific role, and is viewing/modifying parameters. 
1.970     raeburn  2717: 
1.88      www      2718: See lonrights.pm for an example invocation and use.
                   2719: 
                   2720: =cut
                   2721: 
                   2722: #-------------------------------------------
                   2723: sub select_form {
1.1228    raeburn  2724:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2725:     return unless (ref($hashref) eq 'HASH');
                   2726:     if ($onchange) {
                   2727:         $onchange = ' onchange="'.$onchange.'"';
                   2728:     }
1.1228    raeburn  2729:     my $disabled;
                   2730:     if ($readonly) {
                   2731:         $disabled = ' disabled="disabled"';
                   2732:     }
                   2733:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2734:     my @keys;
1.970     raeburn  2735:     if (exists($hashref->{'select_form_order'})) {
                   2736: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2737:     } else {
1.970     raeburn  2738: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2739:     }
1.356     albertel 2740:     foreach my $key (@keys) {
                   2741:         $selectform.=
                   2742: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2743:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2744:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2745:     }
                   2746:     $selectform.="</select>";
                   2747:     return $selectform;
                   2748: }
                   2749: 
1.475     www      2750: # For display filters
                   2751: 
                   2752: sub display_filter {
1.1074    raeburn  2753:     my ($context) = @_;
1.475     www      2754:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2755:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2756:     my $phraseinput = 'hidden';
                   2757:     my $includeinput = 'hidden';
                   2758:     my ($checked,$includetypestext);
                   2759:     if ($env{'form.displayfilter'} eq 'containing') {
                   2760:         $phraseinput = 'text'; 
                   2761:         if ($context eq 'parmslog') {
                   2762:             $includeinput = 'checkbox';
                   2763:             if ($env{'form.includetypes'}) {
                   2764:                 $checked = ' checked="checked"';
                   2765:             }
                   2766:             $includetypestext = &mt('Include parameter types');
                   2767:         }
                   2768:     } else {
                   2769:         $includetypestext = '&nbsp;';
                   2770:     }
                   2771:     my ($additional,$secondid,$thirdid);
                   2772:     if ($context eq 'parmslog') {
                   2773:         $additional = 
                   2774:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2775:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2776:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2777:             '</label>';
                   2778:         $secondid = 'includetypes';
                   2779:         $thirdid = 'includetypestext';
                   2780:     }
                   2781:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2782:                                                     '$secondid','$thirdid')";
                   2783:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.1403  ! raeburn  2784: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},'',undef,
1.475     www      2785: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2786: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2787:            &mt('Filter: [_1]',
1.477     www      2788: 	   &select_form($env{'form.displayfilter'},
                   2789: 			'displayfilter',
1.970     raeburn  2790: 			{'currentfolder' => 'Current folder/page',
1.477     www      2791: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2792: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2793: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2794:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2795:                          '" />'.$additional;
                   2796: }
                   2797: 
                   2798: sub display_filter_js {
                   2799:     my $includetext = &mt('Include parameter types');
                   2800:     return <<"ENDJS";
                   2801:   
                   2802: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2803:     var firstType = 'hidden';
                   2804:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2805:         firstType = 'text';
                   2806:     }
                   2807:     firstObject = document.getElementById(firstid);
                   2808:     if (typeof(firstObject) == 'object') {
                   2809:         if (firstObject.type != firstType) {
                   2810:             changeInputType(firstObject,firstType);
                   2811:         }
                   2812:     }
                   2813:     if (context == 'parmslog') {
                   2814:         var secondType = 'hidden';
                   2815:         if (firstType == 'text') {
                   2816:             secondType = 'checkbox';
                   2817:         }
                   2818:         secondObject = document.getElementById(secondid);  
                   2819:         if (typeof(secondObject) == 'object') {
                   2820:             if (secondObject.type != secondType) {
                   2821:                 changeInputType(secondObject,secondType);
                   2822:             }
                   2823:         }
                   2824:         var textItem = document.getElementById(thirdid);
                   2825:         var currtext = textItem.innerHTML;
                   2826:         var newtext;
                   2827:         if (firstType == 'text') {
                   2828:             newtext = '$includetext';
                   2829:         } else {
                   2830:             newtext = '&nbsp;';
                   2831:         }
                   2832:         if (currtext != newtext) {
                   2833:             textItem.innerHTML = newtext;
                   2834:         }
                   2835:     }
                   2836:     return;
                   2837: }
                   2838: 
                   2839: function changeInputType(oldObject,newType) {
                   2840:     var newObject = document.createElement('input');
                   2841:     newObject.type = newType;
                   2842:     if (oldObject.size) {
                   2843:         newObject.size = oldObject.size;
                   2844:     }
                   2845:     if (oldObject.value) {
                   2846:         newObject.value = oldObject.value;
                   2847:     }
                   2848:     if (oldObject.name) {
                   2849:         newObject.name = oldObject.name;
                   2850:     }
                   2851:     if (oldObject.id) {
                   2852:         newObject.id = oldObject.id;
                   2853:     }
                   2854:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2855:     return;
                   2856: }
                   2857: 
                   2858: ENDJS
1.475     www      2859: }
                   2860: 
1.167     www      2861: sub gradeleveldescription {
                   2862:     my $gradelevel=shift;
                   2863:     my %gradelevels=(0 => 'Not specified',
                   2864: 		     1 => 'Grade 1',
                   2865: 		     2 => 'Grade 2',
                   2866: 		     3 => 'Grade 3',
                   2867: 		     4 => 'Grade 4',
                   2868: 		     5 => 'Grade 5',
                   2869: 		     6 => 'Grade 6',
                   2870: 		     7 => 'Grade 7',
                   2871: 		     8 => 'Grade 8',
                   2872: 		     9 => 'Grade 9',
                   2873: 		     10 => 'Grade 10',
                   2874: 		     11 => 'Grade 11',
                   2875: 		     12 => 'Grade 12',
                   2876: 		     13 => 'Grade 13',
                   2877: 		     14 => '100 Level',
                   2878: 		     15 => '200 Level',
                   2879: 		     16 => '300 Level',
                   2880: 		     17 => '400 Level',
                   2881: 		     18 => 'Graduate Level');
                   2882:     return &mt($gradelevels{$gradelevel});
                   2883: }
                   2884: 
1.163     www      2885: sub select_level_form {
                   2886:     my ($deflevel,$name)=@_;
                   2887:     unless ($deflevel) { $deflevel=0; }
1.167     www      2888:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2889:     for (my $i=0; $i<=18; $i++) {
                   2890:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2891:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2892:                 ">".&gradeleveldescription($i)."</option>\n";
                   2893:     }
                   2894:     $selectform.="</select>";
                   2895:     return $selectform;
1.163     www      2896: }
1.167     www      2897: 
1.35      matthew  2898: #-------------------------------------------
                   2899: 
1.45      matthew  2900: =pod
                   2901: 
1.1256    raeburn  2902: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35      matthew  2903: 
                   2904: Returns a string containing a <select name='$name' size='1'> form to 
                   2905: allow a user to select the domain to preform an operation in.  
                   2906: See loncreateuser.pm for an example invocation and use.
                   2907: 
1.90      www      2908: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2909: selected");
                   2910: 
1.743     raeburn  2911: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2912: 
1.910     raeburn  2913: 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.
                   2914: 
1.1121    raeburn  2915: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2916: 
                   2917: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2918: 
1.1256    raeburn  2919: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
                   2920: 
1.35      matthew  2921: =cut
                   2922: 
                   2923: #-------------------------------------------
1.34      matthew  2924: sub select_dom_form {
1.1256    raeburn  2925:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872     raeburn  2926:     if ($onchange) {
1.874     raeburn  2927:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2928:     }
1.1256    raeburn  2929:     if ($disabled) {
                   2930:         $disabled = ' disabled="disabled"';
                   2931:     }
1.1121    raeburn  2932:     my (@domains,%exclude);
1.910     raeburn  2933:     if (ref($incdoms) eq 'ARRAY') {
                   2934:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2935:     } else {
                   2936:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2937:     }
1.90      www      2938:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2939:     if (ref($excdoms) eq 'ARRAY') {
                   2940:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2941:     }
1.1256    raeburn  2942:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356     albertel 2943:     foreach my $dom (@domains) {
1.1121    raeburn  2944:         next if ($exclude{$dom});
1.356     albertel 2945:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2946:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2947:         if ($showdomdesc) {
                   2948:             if ($dom ne '') {
                   2949:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2950:                 if ($domdesc ne '') {
                   2951:                     $selectdomain .= ' ('.$domdesc.')';
                   2952:                 }
                   2953:             } 
                   2954:         }
                   2955:         $selectdomain .= "</option>\n";
1.34      matthew  2956:     }
                   2957:     $selectdomain.="</select>";
                   2958:     return $selectdomain;
                   2959: }
                   2960: 
1.35      matthew  2961: #-------------------------------------------
                   2962: 
1.45      matthew  2963: =pod
                   2964: 
1.648     raeburn  2965: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2966: 
1.586     raeburn  2967: input: 4 arguments (two required, two optional) - 
                   2968:     $domain - domain of new user
                   2969:     $name - name of form element
                   2970:     $default - Value of 'default' causes a default item to be first 
                   2971:                             option, and selected by default. 
                   2972:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2973:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2974: output: returns 2 items: 
1.586     raeburn  2975: (a) form element which contains either:
                   2976:    (i) <select name="$name">
                   2977:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2978:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2979:        </select>
                   2980:        form item if there are multiple library servers in $domain, or
                   2981:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2982:        if there is only one library server in $domain.
                   2983: 
                   2984: (b) number of library servers found.
                   2985: 
                   2986: See loncreateuser.pm for example of use.
1.35      matthew  2987: 
                   2988: =cut
                   2989: 
                   2990: #-------------------------------------------
1.586     raeburn  2991: sub home_server_form_item {
                   2992:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2993:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2994:     my $result;
                   2995:     my $numlib = keys(%servers);
                   2996:     if ($numlib > 1) {
                   2997:         $result .= '<select name="'.$name.'" />'."\n";
                   2998:         if ($default) {
1.804     bisitz   2999:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  3000:                        '</option>'."\n";
                   3001:         }
                   3002:         foreach my $hostid (sort(keys(%servers))) {
                   3003:             $result.= '<option value="'.$hostid.'">'.
                   3004: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   3005:         }
                   3006:         $result .= '</select>'."\n";
                   3007:     } elsif ($numlib == 1) {
                   3008:         my $hostid;
                   3009:         foreach my $item (keys(%servers)) {
                   3010:             $hostid = $item;
                   3011:         }
                   3012:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   3013:                    $hostid.'" />';
                   3014:                    if (!$hide) {
                   3015:                        $result .= $hostid.' '.$servers{$hostid};
                   3016:                    }
                   3017:                    $result .= "\n";
                   3018:     } elsif ($default) {
                   3019:         $result .= '<input type="hidden" name="'.$name.
                   3020:                    '" value="default" />';
                   3021:                    if (!$hide) {
                   3022:                        $result .= &mt('default');
                   3023:                    }
                   3024:                    $result .= "\n";
1.33      matthew  3025:     }
1.586     raeburn  3026:     return ($result,$numlib);
1.33      matthew  3027: }
1.112     bowersj2 3028: 
                   3029: =pod
                   3030: 
1.534     albertel 3031: =back 
                   3032: 
1.112     bowersj2 3033: =cut
1.87      matthew  3034: 
                   3035: ###############################################################
1.112     bowersj2 3036: ##                  Decoding User Agent                      ##
1.87      matthew  3037: ###############################################################
                   3038: 
                   3039: =pod
                   3040: 
1.112     bowersj2 3041: =head1 Decoding the User Agent
                   3042: 
                   3043: =over 4
                   3044: 
                   3045: =item * &decode_user_agent()
1.87      matthew  3046: 
                   3047: Inputs: $r
                   3048: 
                   3049: Outputs:
                   3050: 
                   3051: =over 4
                   3052: 
1.112     bowersj2 3053: =item * $httpbrowser
1.87      matthew  3054: 
1.112     bowersj2 3055: =item * $clientbrowser
1.87      matthew  3056: 
1.112     bowersj2 3057: =item * $clientversion
1.87      matthew  3058: 
1.112     bowersj2 3059: =item * $clientmathml
1.87      matthew  3060: 
1.112     bowersj2 3061: =item * $clientunicode
1.87      matthew  3062: 
1.112     bowersj2 3063: =item * $clientos
1.87      matthew  3064: 
1.1137    raeburn  3065: =item * $clientmobile
                   3066: 
1.1141    raeburn  3067: =item * $clientinfo
                   3068: 
1.1194    raeburn  3069: =item * $clientosversion
                   3070: 
1.87      matthew  3071: =back
                   3072: 
1.157     matthew  3073: =back 
                   3074: 
1.87      matthew  3075: =cut
                   3076: 
                   3077: ###############################################################
                   3078: ###############################################################
                   3079: sub decode_user_agent {
1.247     albertel 3080:     my ($r)=@_;
1.87      matthew  3081:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   3082:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   3083:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 3084:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  3085:     my $clientbrowser='unknown';
                   3086:     my $clientversion='0';
                   3087:     my $clientmathml='';
                   3088:     my $clientunicode='0';
1.1137    raeburn  3089:     my $clientmobile=0;
1.1194    raeburn  3090:     my $clientosversion='';
1.87      matthew  3091:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1193    raeburn  3092:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  3093: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   3094: 	    $clientbrowser=$bname;
                   3095:             $httpbrowser=~/$vreg/i;
                   3096: 	    $clientversion=$1;
                   3097:             $clientmathml=($clientversion>=$minv);
                   3098:             $clientunicode=($clientversion>=$univ);
                   3099: 	}
                   3100:     }
                   3101:     my $clientos='unknown';
1.1141    raeburn  3102:     my $clientinfo;
1.87      matthew  3103:     if (($httpbrowser=~/linux/i) ||
                   3104:         ($httpbrowser=~/unix/i) ||
                   3105:         ($httpbrowser=~/ux/i) ||
                   3106:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   3107:     if (($httpbrowser=~/vax/i) ||
                   3108:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   3109:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   3110:     if (($httpbrowser=~/mac/i) ||
                   3111:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194    raeburn  3112:     if ($httpbrowser=~/win/i) {
                   3113:         $clientos='win';
                   3114:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   3115:             $clientosversion = $1;
                   3116:         }
                   3117:     }
1.87      matthew  3118:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  3119:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   3120:         $clientmobile=lc($1);
                   3121:     }
1.1141    raeburn  3122:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   3123:         $clientinfo = 'firefox-'.$1;
                   3124:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   3125:         $clientinfo = 'chromeframe-'.$1;
                   3126:     }
1.87      matthew  3127:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194    raeburn  3128:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   3129:             $clientosversion);
1.87      matthew  3130: }
                   3131: 
1.32      matthew  3132: ###############################################################
                   3133: ##    Authentication changing form generation subroutines    ##
                   3134: ###############################################################
                   3135: ##
                   3136: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   3137: ## hash, and have reasonable default values.
                   3138: ##
                   3139: ##    formname = the name given in the <form> tag.
1.35      matthew  3140: #-------------------------------------------
                   3141: 
1.45      matthew  3142: =pod
                   3143: 
1.112     bowersj2 3144: =head1 Authentication Routines
                   3145: 
                   3146: =over 4
                   3147: 
1.648     raeburn  3148: =item * &authform_xxxxxx()
1.35      matthew  3149: 
                   3150: The authform_xxxxxx subroutines provide javascript and html forms which 
                   3151: handle some of the conveniences required for authentication forms.  
                   3152: This is not an optimal method, but it works.  
                   3153: 
                   3154: =over 4
                   3155: 
1.112     bowersj2 3156: =item * authform_header
1.35      matthew  3157: 
1.112     bowersj2 3158: =item * authform_authorwarning
1.35      matthew  3159: 
1.112     bowersj2 3160: =item * authform_nochange
1.35      matthew  3161: 
1.112     bowersj2 3162: =item * authform_kerberos
1.35      matthew  3163: 
1.112     bowersj2 3164: =item * authform_internal
1.35      matthew  3165: 
1.112     bowersj2 3166: =item * authform_filesystem
1.35      matthew  3167: 
1.1310    raeburn  3168: =item * authform_lti
                   3169: 
1.35      matthew  3170: =back
                   3171: 
1.648     raeburn  3172: See loncreateuser.pm for invocation and use examples.
1.157     matthew  3173: 
1.35      matthew  3174: =cut
                   3175: 
                   3176: #-------------------------------------------
1.32      matthew  3177: sub authform_header{  
                   3178:     my %in = (
                   3179:         formname => 'cu',
1.80      albertel 3180:         kerb_def_dom => '',
1.32      matthew  3181:         @_,
                   3182:     );
                   3183:     $in{'formname'} = 'document.' . $in{'formname'};
                   3184:     my $result='';
1.80      albertel 3185: 
                   3186: #---------------------------------------------- Code for upper case translation
                   3187:     my $Javascript_toUpperCase;
                   3188:     unless ($in{kerb_def_dom}) {
                   3189:         $Javascript_toUpperCase =<<"END";
                   3190:         switch (choice) {
                   3191:            case 'krb': currentform.elements[choicearg].value =
                   3192:                currentform.elements[choicearg].value.toUpperCase();
                   3193:                break;
                   3194:            default:
                   3195:         }
                   3196: END
                   3197:     } else {
                   3198:         $Javascript_toUpperCase = "";
                   3199:     }
                   3200: 
1.165     raeburn  3201:     my $radioval = "'nochange'";
1.591     raeburn  3202:     if (defined($in{'curr_authtype'})) {
                   3203:         if ($in{'curr_authtype'} ne '') {
                   3204:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   3205:         }
1.174     matthew  3206:     }
1.165     raeburn  3207:     my $argfield = 'null';
1.591     raeburn  3208:     if (defined($in{'mode'})) {
1.165     raeburn  3209:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  3210:             if (defined($in{'curr_autharg'})) {
                   3211:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  3212:                     $argfield = "'$in{'curr_autharg'}'";
                   3213:                 }
                   3214:             }
                   3215:         }
                   3216:     }
                   3217: 
1.32      matthew  3218:     $result.=<<"END";
                   3219: var current = new Object();
1.165     raeburn  3220: current.radiovalue = $radioval;
                   3221: current.argfield = $argfield;
1.32      matthew  3222: 
                   3223: function changed_radio(choice,currentform) {
                   3224:     var choicearg = choice + 'arg';
                   3225:     // If a radio button in changed, we need to change the argfield
                   3226:     if (current.radiovalue != choice) {
                   3227:         current.radiovalue = choice;
                   3228:         if (current.argfield != null) {
                   3229:             currentform.elements[current.argfield].value = '';
                   3230:         }
                   3231:         if (choice == 'nochange') {
                   3232:             current.argfield = null;
                   3233:         } else {
                   3234:             current.argfield = choicearg;
                   3235:             switch(choice) {
                   3236:                 case 'krb': 
                   3237:                     currentform.elements[current.argfield].value = 
                   3238:                         "$in{'kerb_def_dom'}";
                   3239:                 break;
                   3240:               default:
                   3241:                 break;
                   3242:             }
                   3243:         }
                   3244:     }
                   3245:     return;
                   3246: }
1.22      www      3247: 
1.32      matthew  3248: function changed_text(choice,currentform) {
                   3249:     var choicearg = choice + 'arg';
                   3250:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 3251:         $Javascript_toUpperCase
1.32      matthew  3252:         // clear old field
                   3253:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   3254:             currentform.elements[current.argfield].value = '';
                   3255:         }
                   3256:         current.argfield = choicearg;
                   3257:     }
                   3258:     set_auth_radio_buttons(choice,currentform);
                   3259:     return;
1.20      www      3260: }
1.32      matthew  3261: 
                   3262: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  3263:     var numauthchoices = currentform.login.length;
                   3264:     if (typeof numauthchoices  == "undefined") {
                   3265:         return;
                   3266:     } 
1.32      matthew  3267:     var i=0;
1.986     raeburn  3268:     while (i < numauthchoices) {
1.32      matthew  3269:         if (currentform.login[i].value == newvalue) { break; }
                   3270:         i++;
                   3271:     }
1.986     raeburn  3272:     if (i == numauthchoices) {
1.32      matthew  3273:         return;
                   3274:     }
                   3275:     current.radiovalue = newvalue;
                   3276:     currentform.login[i].checked = true;
                   3277:     return;
                   3278: }
                   3279: END
                   3280:     return $result;
                   3281: }
                   3282: 
1.1106    raeburn  3283: sub authform_authorwarning {
1.32      matthew  3284:     my $result='';
1.144     matthew  3285:     $result='<i>'.
                   3286:         &mt('As a general rule, only authors or co-authors should be '.
                   3287:             'filesystem authenticated '.
                   3288:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  3289:     return $result;
                   3290: }
                   3291: 
1.1106    raeburn  3292: sub authform_nochange {
1.32      matthew  3293:     my %in = (
                   3294:               formname => 'document.cu',
                   3295:               kerb_def_dom => 'MSU.EDU',
                   3296:               @_,
                   3297:           );
1.1106    raeburn  3298:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  3299:     my $result;
1.1104    raeburn  3300:     if (!$authnum) {
1.1105    raeburn  3301:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  3302:     } else {
                   3303:         $result = '<label>'.&mt('[_1] Do not change login data',
                   3304:                   '<input type="radio" name="login" value="nochange" '.
                   3305:                   'checked="checked" onclick="'.
1.281     albertel 3306:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   3307: 	    '</label>';
1.586     raeburn  3308:     }
1.32      matthew  3309:     return $result;
                   3310: }
                   3311: 
1.591     raeburn  3312: sub authform_kerberos {
1.32      matthew  3313:     my %in = (
                   3314:               formname => 'document.cu',
                   3315:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 3316:               kerb_def_auth => 'krb4',
1.32      matthew  3317:               @_,
                   3318:               );
1.586     raeburn  3319:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259    raeburn  3320:         $autharg,$jscall,$disabled);
1.1106    raeburn  3321:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 3322:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   3323:        $check5 = ' checked="checked"';
1.80      albertel 3324:     } else {
1.772     bisitz   3325:        $check4 = ' checked="checked"';
1.80      albertel 3326:     }
1.1259    raeburn  3327:     if ($in{'readonly'}) {
                   3328:         $disabled = ' disabled="disabled"';
                   3329:     }
1.165     raeburn  3330:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  3331:     if (defined($in{'curr_authtype'})) {
                   3332:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   3333:             $krbcheck = ' checked="checked"';
1.623     raeburn  3334:             if (defined($in{'mode'})) {
                   3335:                 if ($in{'mode'} eq 'modifyuser') {
                   3336:                     $krbcheck = '';
                   3337:                 }
                   3338:             }
1.591     raeburn  3339:             if (defined($in{'curr_kerb_ver'})) {
                   3340:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   3341:                     $check5 = ' checked="checked"';
1.591     raeburn  3342:                     $check4 = '';
                   3343:                 } else {
1.772     bisitz   3344:                     $check4 = ' checked="checked"';
1.591     raeburn  3345:                     $check5 = '';
                   3346:                 }
1.586     raeburn  3347:             }
1.591     raeburn  3348:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  3349:                 $krbarg = $in{'curr_autharg'};
                   3350:             }
1.586     raeburn  3351:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  3352:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3353:                     $result = 
                   3354:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   3355:         $in{'curr_autharg'},$krbver);
                   3356:                 } else {
                   3357:                     $result =
                   3358:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   3359:                 }
                   3360:                 return $result; 
                   3361:             }
                   3362:         }
                   3363:     } else {
                   3364:         if ($authnum == 1) {
1.784     bisitz   3365:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  3366:         }
                   3367:     }
1.586     raeburn  3368:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   3369:         return;
1.587     raeburn  3370:     } elsif ($authtype eq '') {
1.591     raeburn  3371:         if (defined($in{'mode'})) {
1.587     raeburn  3372:             if ($in{'mode'} eq 'modifycourse') {
                   3373:                 if ($authnum == 1) {
1.1259    raeburn  3374:                     $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587     raeburn  3375:                 }
                   3376:             }
                   3377:         }
1.586     raeburn  3378:     }
                   3379:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   3380:     if ($authtype eq '') {
                   3381:         $authtype = '<input type="radio" name="login" value="krb" '.
                   3382:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259    raeburn  3383:                     $krbcheck.$disabled.' />';
1.586     raeburn  3384:     }
                   3385:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  3386:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  3387:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  3388:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  3389:          $in{'curr_authtype'} eq 'krb4')) {
                   3390:         $result .= &mt
1.144     matthew  3391:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 3392:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  3393:          '<label>'.$authtype,
1.281     albertel 3394:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  3395:              'value="'.$krbarg.'" '.
1.1259    raeburn  3396:              'onchange="'.$jscall.'"'.$disabled.' />',
                   3397:          '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
                   3398:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281     albertel 3399: 	 '</label>');
1.586     raeburn  3400:     } elsif ($can_assign{'krb4'}) {
                   3401:         $result .= &mt
                   3402:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3403:          '[_3] Version 4 [_4]',
                   3404:          '<label>'.$authtype,
                   3405:          '</label><input type="text" size="10" name="krbarg" '.
                   3406:              'value="'.$krbarg.'" '.
1.1259    raeburn  3407:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3408:          '<label><input type="hidden" name="krbver" value="4" />',
                   3409:          '</label>');
                   3410:     } elsif ($can_assign{'krb5'}) {
                   3411:         $result .= &mt
                   3412:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3413:          '[_3] Version 5 [_4]',
                   3414:          '<label>'.$authtype,
                   3415:          '</label><input type="text" size="10" name="krbarg" '.
                   3416:              'value="'.$krbarg.'" '.
1.1259    raeburn  3417:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3418:          '<label><input type="hidden" name="krbver" value="5" />',
                   3419:          '</label>');
                   3420:     }
1.32      matthew  3421:     return $result;
                   3422: }
                   3423: 
1.1106    raeburn  3424: sub authform_internal {
1.586     raeburn  3425:     my %in = (
1.32      matthew  3426:                 formname => 'document.cu',
                   3427:                 kerb_def_dom => 'MSU.EDU',
                   3428:                 @_,
                   3429:                 );
1.1259    raeburn  3430:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3431:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3432:     if ($in{'readonly'}) {
                   3433:         $disabled = ' disabled="disabled"';
                   3434:     }
1.591     raeburn  3435:     if (defined($in{'curr_authtype'})) {
                   3436:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  3437:             if ($can_assign{'int'}) {
1.772     bisitz   3438:                 $intcheck = 'checked="checked" ';
1.623     raeburn  3439:                 if (defined($in{'mode'})) {
                   3440:                     if ($in{'mode'} eq 'modifyuser') {
                   3441:                         $intcheck = '';
                   3442:                     }
                   3443:                 }
1.591     raeburn  3444:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3445:                     $intarg = $in{'curr_autharg'};
                   3446:                 }
                   3447:             } else {
                   3448:                 $result = &mt('Currently internally authenticated.');
                   3449:                 return $result;
1.165     raeburn  3450:             }
                   3451:         }
1.586     raeburn  3452:     } else {
                   3453:         if ($authnum == 1) {
1.784     bisitz   3454:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  3455:         }
                   3456:     }
                   3457:     if (!$can_assign{'int'}) {
                   3458:         return;
1.587     raeburn  3459:     } elsif ($authtype eq '') {
1.591     raeburn  3460:         if (defined($in{'mode'})) {
1.587     raeburn  3461:             if ($in{'mode'} eq 'modifycourse') {
                   3462:                 if ($authnum == 1) {
1.1259    raeburn  3463:                     $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587     raeburn  3464:                 }
                   3465:             }
                   3466:         }
1.165     raeburn  3467:     }
1.586     raeburn  3468:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3469:     if ($authtype eq '') {
                   3470:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259    raeburn  3471:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3472:     }
1.605     bisitz   3473:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259    raeburn  3474:                $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3475:     $result = &mt
1.144     matthew  3476:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3477:          '<label>'.$authtype,'</label>'.$autharg);
1.1259    raeburn  3478:     $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  3479:     return $result;
                   3480: }
                   3481: 
1.1104    raeburn  3482: sub authform_local {
1.32      matthew  3483:     my %in = (
                   3484:               formname => 'document.cu',
                   3485:               kerb_def_dom => 'MSU.EDU',
                   3486:               @_,
                   3487:               );
1.1259    raeburn  3488:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3489:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3490:     if ($in{'readonly'}) {
                   3491:         $disabled = ' disabled="disabled"';
                   3492:     } 
1.591     raeburn  3493:     if (defined($in{'curr_authtype'})) {
                   3494:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3495:             if ($can_assign{'loc'}) {
1.772     bisitz   3496:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3497:                 if (defined($in{'mode'})) {
                   3498:                     if ($in{'mode'} eq 'modifyuser') {
                   3499:                         $loccheck = '';
                   3500:                     }
                   3501:                 }
1.591     raeburn  3502:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3503:                     $locarg = $in{'curr_autharg'};
                   3504:                 }
                   3505:             } else {
                   3506:                 $result = &mt('Currently using local (institutional) authentication.');
                   3507:                 return $result;
1.165     raeburn  3508:             }
                   3509:         }
1.586     raeburn  3510:     } else {
                   3511:         if ($authnum == 1) {
1.784     bisitz   3512:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3513:         }
                   3514:     }
                   3515:     if (!$can_assign{'loc'}) {
                   3516:         return;
1.587     raeburn  3517:     } elsif ($authtype eq '') {
1.591     raeburn  3518:         if (defined($in{'mode'})) {
1.587     raeburn  3519:             if ($in{'mode'} eq 'modifycourse') {
                   3520:                 if ($authnum == 1) {
1.1259    raeburn  3521:                     $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587     raeburn  3522:                 }
                   3523:             }
                   3524:         }
1.165     raeburn  3525:     }
1.586     raeburn  3526:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3527:     if ($authtype eq '') {
                   3528:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3529:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259    raeburn  3530:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3531:     }
                   3532:     $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259    raeburn  3533:                $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3534:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3535:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3536:     return $result;
                   3537: }
                   3538: 
1.1106    raeburn  3539: sub authform_filesystem {
1.32      matthew  3540:     my %in = (
                   3541:               formname => 'document.cu',
                   3542:               kerb_def_dom => 'MSU.EDU',
                   3543:               @_,
                   3544:               );
1.1259    raeburn  3545:     my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3546:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3547:     if ($in{'readonly'}) {
                   3548:         $disabled = ' disabled="disabled"';
                   3549:     }
1.591     raeburn  3550:     if (defined($in{'curr_authtype'})) {
                   3551:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3552:             if ($can_assign{'fsys'}) {
1.772     bisitz   3553:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3554:                 if (defined($in{'mode'})) {
                   3555:                     if ($in{'mode'} eq 'modifyuser') {
                   3556:                         $fsyscheck = '';
                   3557:                     }
                   3558:                 }
1.586     raeburn  3559:             } else {
                   3560:                 $result = &mt('Currently Filesystem Authenticated.');
                   3561:                 return $result;
1.1259    raeburn  3562:             }
1.586     raeburn  3563:         }
                   3564:     } else {
                   3565:         if ($authnum == 1) {
1.784     bisitz   3566:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3567:         }
                   3568:     }
                   3569:     if (!$can_assign{'fsys'}) {
                   3570:         return;
1.587     raeburn  3571:     } elsif ($authtype eq '') {
1.591     raeburn  3572:         if (defined($in{'mode'})) {
1.587     raeburn  3573:             if ($in{'mode'} eq 'modifycourse') {
                   3574:                 if ($authnum == 1) {
1.1259    raeburn  3575:                     $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587     raeburn  3576:                 }
                   3577:             }
                   3578:         }
1.586     raeburn  3579:     }
                   3580:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3581:     if ($authtype eq '') {
                   3582:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3583:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259    raeburn  3584:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3585:     }
1.1310    raeburn  3586:     $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259    raeburn  3587:                ' onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3588:     $result = &mt
1.144     matthew  3589:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310    raeburn  3590:          '<label>'.$authtype,'</label>'.$autharg);
                   3591:     return $result;
                   3592: }
                   3593: 
                   3594: sub authform_lti {
                   3595:     my %in = (
                   3596:               formname => 'document.cu',
                   3597:               kerb_def_dom => 'MSU.EDU',
                   3598:               @_,
                   3599:               );
                   3600:     my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
                   3601:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
                   3602:     if ($in{'readonly'}) {
                   3603:         $disabled = ' disabled="disabled"';
                   3604:     }
                   3605:     if (defined($in{'curr_authtype'})) {
                   3606:         if ($in{'curr_authtype'} eq 'lti') {
                   3607:             if ($can_assign{'lti'}) {
                   3608:                 $lticheck = 'checked="checked" ';
                   3609:                 if (defined($in{'mode'})) {
                   3610:                     if ($in{'mode'} eq 'modifyuser') {
                   3611:                         $lticheck = '';
                   3612:                     }
                   3613:                 }
                   3614:             } else {
                   3615:                 $result = &mt('Currently LTI Authenticated.');
                   3616:                 return $result;
                   3617:             }
                   3618:         }
                   3619:     } else {
                   3620:         if ($authnum == 1) {
                   3621:             $authtype = '<input type="hidden" name="login" value="lti" />';
                   3622:         }
                   3623:     }
                   3624:     if (!$can_assign{'lti'}) {
                   3625:         return;
                   3626:     } elsif ($authtype eq '') {
                   3627:         if (defined($in{'mode'})) {
                   3628:             if ($in{'mode'} eq 'modifycourse') {
                   3629:                 if ($authnum == 1) {
                   3630:                     $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
                   3631:                 }
                   3632:             }
                   3633:         }
                   3634:     }
                   3635:     $jscall = "javascript:changed_radio('lti',$in{'formname'});";
                   3636:     if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
                   3637:         $authtype = '<input type="radio" name="login" value="lti" '.
                   3638:                     $lticheck.' onchange="'.$jscall.'" onclick="'.
                   3639:                     $jscall.'"'.$disabled.' />';
                   3640:     }
                   3641:     $autharg = '<input type="hidden" name="ltiarg" value="" />';
                   3642:     if ($authtype) {
                   3643:         $result = &mt('[_1] LTI Authenticated',
                   3644:                       '<label>'.$authtype.'</label>'.$autharg);
                   3645:     } else {
                   3646:         $result = '<b>'.&mt('LTI Authenticated').'</b>'.
                   3647:                   $autharg;
                   3648:     }
1.32      matthew  3649:     return $result;
                   3650: }
                   3651: 
1.586     raeburn  3652: sub get_assignable_auth {
                   3653:     my ($dom) = @_;
                   3654:     if ($dom eq '') {
                   3655:         $dom = $env{'request.role.domain'};
                   3656:     }
                   3657:     my %can_assign = (
                   3658:                           krb4 => 1,
                   3659:                           krb5 => 1,
                   3660:                           int  => 1,
                   3661:                           loc  => 1,
1.1310    raeburn  3662:                           lti  => 1,
1.586     raeburn  3663:                      );
                   3664:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3665:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3666:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3667:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3668:             my $context;
                   3669:             if ($env{'request.role'} =~ /^au/) {
                   3670:                 $context = 'author';
1.1259    raeburn  3671:             } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586     raeburn  3672:                 $context = 'domain';
                   3673:             } elsif ($env{'request.course.id'}) {
                   3674:                 $context = 'course';
                   3675:             }
                   3676:             if ($context) {
                   3677:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3678:                    %can_assign = %{$authhash->{$context}}; 
                   3679:                 }
                   3680:             }
                   3681:         }
                   3682:     }
                   3683:     my $authnum = 0;
                   3684:     foreach my $key (keys(%can_assign)) {
                   3685:         if ($can_assign{$key}) {
                   3686:             $authnum ++;
                   3687:         }
                   3688:     }
                   3689:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3690:         $authnum --;
                   3691:     }
                   3692:     return ($authnum,%can_assign);
                   3693: }
                   3694: 
1.1331    raeburn  3695: sub check_passwd_rules {
                   3696:     my ($domain,$plainpass) = @_;
                   3697:     my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3698:     my ($min,$max,@chars,@brokerule,$warning);
1.1333    raeburn  3699:     $min = $Apache::lonnet::passwdmin;
1.1331    raeburn  3700:     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3701:         if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333    raeburn  3702:             if ($passwdconf{'min'} > $min) {
                   3703:                 $min = $passwdconf{'min'};
                   3704:             }
1.1331    raeburn  3705:         }
                   3706:         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3707:             $max = $passwdconf{'max'};
                   3708:         }
                   3709:         @chars = @{$passwdconf{'chars'}};
                   3710:     }
                   3711:     if (($min) && (length($plainpass) < $min)) {
                   3712:         push(@brokerule,'min');
                   3713:     }
                   3714:     if (($max) && (length($plainpass) > $max)) {
                   3715:         push(@brokerule,'max');
                   3716:     }
                   3717:     if (@chars) {
                   3718:         my %rules;
                   3719:         map { $rules{$_} = 1; } @chars;
                   3720:         if ($rules{'uc'}) {
                   3721:             unless ($plainpass =~ /[A-Z]/) {
                   3722:                 push(@brokerule,'uc');
                   3723:             }
                   3724:         }
                   3725:         if ($rules{'lc'}) {
1.1332    raeburn  3726:             unless ($plainpass =~ /[a-z]/) {
1.1331    raeburn  3727:                 push(@brokerule,'lc');
                   3728:             }
                   3729:         }
                   3730:         if ($rules{'num'}) {
                   3731:             unless ($plainpass =~ /\d/) {
                   3732:                 push(@brokerule,'num');
                   3733:             }
                   3734:         }
                   3735:         if ($rules{'spec'}) {
                   3736:             unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   3737:                 push(@brokerule,'spec');
                   3738:             }
                   3739:         }
                   3740:     }
                   3741:     if (@brokerule) {
                   3742:         my %rulenames = &Apache::lonlocal::texthash(
                   3743:             uc   => 'At least one upper case letter',
                   3744:             lc   => 'At least one lower case letter',
                   3745:             num  => 'At least one number',
                   3746:             spec => 'At least one non-alphanumeric',
                   3747:         );
                   3748:         $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
                   3749:         $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
                   3750:         $rulenames{'num'} .= ': 0123456789';
                   3751:         $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
                   3752:         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
                   3753:         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
                   3754:         $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336    raeburn  3755:         foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331    raeburn  3756:             if (grep(/^$rule$/,@brokerule)) {
                   3757:                 $warning .= '<li>'.$rulenames{$rule}.'</li>';
                   3758:             }
                   3759:         }
                   3760:         $warning .= '</ul>';
                   3761:     }
1.1332    raeburn  3762:     if (wantarray) {
                   3763:         return @brokerule;
                   3764:     }
1.1331    raeburn  3765:     return $warning;
                   3766: }
                   3767: 
1.1376    raeburn  3768: sub passwd_validation_js {
1.1377    raeburn  3769:     my ($currpasswdval,$domain,$context,$id) = @_;
                   3770:     my (%passwdconf,$alertmsg);
                   3771:     if ($context eq 'linkprot') {
                   3772:         my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
                   3773:         if (ref($domconfig{'ltisec'}) eq 'HASH') {
                   3774:             if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
                   3775:                 %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
                   3776:             }
                   3777:         }
                   3778:         if ($id eq 'add') {
                   3779:             $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
                   3780:         } elsif ($id =~ /^\d+$/) {
                   3781:             my $pos = $id+1;
                   3782:             $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
                   3783:         } else {
                   3784:             $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
                   3785:         }
                   3786:     } else {
                   3787:         %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3788:         $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
                   3789:     }
1.1376    raeburn  3790:     my ($min,$max,@chars,$numrules,$intargjs,%alert);
                   3791:     $numrules = 0;
                   3792:     $min = $Apache::lonnet::passwdmin;
                   3793:     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3794:         if ($passwdconf{'min'} =~ /^\d+$/) {
                   3795:             if ($passwdconf{'min'} > $min) {
                   3796:                 $min = $passwdconf{'min'};
                   3797:             }
                   3798:         }
                   3799:         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3800:             $max = $passwdconf{'max'};
                   3801:             $numrules ++;
                   3802:         }
                   3803:         @chars = @{$passwdconf{'chars'}};
                   3804:         if (@chars) {
                   3805:             $numrules ++;
                   3806:         }
                   3807:     }
                   3808:     if ($min > 0) {
                   3809:         $numrules ++;
                   3810:     }
                   3811:     if (($min > 0) || ($max ne '') || (@chars > 0)) {
                   3812:         if ($min) {
                   3813:             $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
                   3814:         }
                   3815:         if ($max) {
                   3816:             $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
                   3817:         }
                   3818:         my (@charalerts,@charrules);
                   3819:         if (@chars) {
                   3820:             if (grep(/^uc$/,@chars)) {
                   3821:                 push(@charalerts,&mt('contain at least one upper case letter'));
                   3822:                 push(@charrules,'uc');
                   3823:             }
                   3824:             if (grep(/^lc$/,@chars)) {
                   3825:                 push(@charalerts,&mt('contain at least one lower case letter'));
                   3826:                 push(@charrules,'lc');
                   3827:             }
                   3828:             if (grep(/^num$/,@chars)) {
                   3829:                 push(@charalerts,&mt('contain at least one number'));
                   3830:                 push(@charrules,'num');
                   3831:             }
                   3832:             if (grep(/^spec$/,@chars)) {
                   3833:                 push(@charalerts,&mt('contain at least one non-alphanumeric'));
                   3834:                 push(@charrules,'spec');
                   3835:             }
                   3836:         }
                   3837:         $intargjs = qq|            var rulesmsg = '';\n|.
                   3838:                     qq|            var currpwval = $currpasswdval;\n|;
                   3839:             if ($min) {
                   3840:                 $intargjs .= qq|
                   3841:             if (currpwval.length < $min) {
                   3842:                 rulesmsg += ' - $alert{min}';
                   3843:             }
                   3844: |;
                   3845:             }
                   3846:             if ($max) {
                   3847:                 $intargjs .= qq|
                   3848:             if (currpwval.length > $max) {
                   3849:                 rulesmsg += ' - $alert{max}';
                   3850:             }
                   3851: |;
                   3852:             }
                   3853:             if (@chars > 0) {
                   3854:                 my $charrulestr = '"'.join('","',@charrules).'"';
                   3855:                 my $charalertstr = '"'.join('","',@charalerts).'"';
                   3856:                 $intargjs .= qq|            var brokerules = new Array();\n|.
                   3857:                              qq|            var charrules = new Array($charrulestr);\n|.
                   3858:                              qq|            var charalerts = new Array($charalertstr);\n|;
                   3859:                 my %rules;
                   3860:                 map { $rules{$_} = 1; } @chars;
                   3861:                 if ($rules{'uc'}) {
                   3862:                     $intargjs .= qq|
                   3863:             var ucRegExp = /[A-Z]/;
                   3864:             if (!ucRegExp.test(currpwval)) {
                   3865:                 brokerules.push('uc');
                   3866:             }
                   3867: |;
                   3868:                 }
                   3869:                 if ($rules{'lc'}) {
                   3870:                     $intargjs .= qq|
                   3871:             var lcRegExp = /[a-z]/;
                   3872:             if (!lcRegExp.test(currpwval)) {
                   3873:                 brokerules.push('lc');
                   3874:             }
                   3875: |;
                   3876:                 }
                   3877:                 if ($rules{'num'}) {
                   3878:                      $intargjs .= qq|
                   3879:             var numRegExp = /[0-9]/;
                   3880:             if (!numRegExp.test(currpwval)) {
                   3881:                 brokerules.push('num');
                   3882:             }
                   3883: |;
                   3884:                 }
                   3885:                 if ($rules{'spec'}) {
                   3886:                      $intargjs .= q|
                   3887:             var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
                   3888:             if (!specRegExp.test(currpwval)) {
                   3889:                 brokerules.push('spec');
                   3890:             }
                   3891: |;
                   3892:                 }
                   3893:                 $intargjs .= qq|
                   3894:             if (brokerules.length > 0) {
                   3895:                 for (var i=0; i<brokerules.length; i++) {
                   3896:                     for (var j=0; j<charrules.length; j++) {
                   3897:                         if (brokerules[i] == charrules[j]) {
                   3898:                             rulesmsg += ' - '+charalerts[j]+'\\n';
                   3899:                             break;
                   3900:                         }
                   3901:                     }
                   3902:                 }
                   3903:             }
                   3904: |;
                   3905:             }
                   3906:             $intargjs .= qq|
                   3907:             if (rulesmsg != '') {
                   3908:                 rulesmsg = '$alertmsg'+rulesmsg;
                   3909:                 alert(rulesmsg);
                   3910:                 return false;
                   3911:             }
                   3912: |;
                   3913:     }
                   3914:     return ($numrules,$intargjs);
                   3915: }
                   3916: 
1.80      albertel 3917: ###############################################################
                   3918: ##    Get Kerberos Defaults for Domain                 ##
                   3919: ###############################################################
                   3920: ##
                   3921: ## Returns default kerberos version and an associated argument
                   3922: ## as listed in file domain.tab. If not listed, provides
                   3923: ## appropriate default domain and kerberos version.
                   3924: ##
                   3925: #-------------------------------------------
                   3926: 
                   3927: =pod
                   3928: 
1.648     raeburn  3929: =item * &get_kerberos_defaults()
1.80      albertel 3930: 
                   3931: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3932: version and domain. If not found, it defaults to version 4 and the 
                   3933: domain of the server.
1.80      albertel 3934: 
1.648     raeburn  3935: =over 4
                   3936: 
1.80      albertel 3937: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3938: 
1.648     raeburn  3939: =back
                   3940: 
                   3941: =back
                   3942: 
1.80      albertel 3943: =cut
                   3944: 
                   3945: #-------------------------------------------
                   3946: sub get_kerberos_defaults {
                   3947:     my $domain=shift;
1.641     raeburn  3948:     my ($krbdef,$krbdefdom);
                   3949:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3950:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3951:         $krbdef = $domdefaults{'auth_def'};
                   3952:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3953:     } else {
1.80      albertel 3954:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3955:         my $krbdefdom=$1;
                   3956:         $krbdefdom=~tr/a-z/A-Z/;
                   3957:         $krbdef = "krb4";
                   3958:     }
                   3959:     return ($krbdef,$krbdefdom);
                   3960: }
1.112     bowersj2 3961: 
1.32      matthew  3962: 
1.46      matthew  3963: ###############################################################
                   3964: ##                Thesaurus Functions                        ##
                   3965: ###############################################################
1.20      www      3966: 
1.46      matthew  3967: =pod
1.20      www      3968: 
1.112     bowersj2 3969: =head1 Thesaurus Functions
                   3970: 
                   3971: =over 4
                   3972: 
1.648     raeburn  3973: =item * &initialize_keywords()
1.46      matthew  3974: 
                   3975: Initializes the package variable %Keywords if it is empty.  Uses the
                   3976: package variable $thesaurus_db_file.
                   3977: 
                   3978: =cut
                   3979: 
                   3980: ###################################################
                   3981: 
                   3982: sub initialize_keywords {
                   3983:     return 1 if (scalar keys(%Keywords));
                   3984:     # If we are here, %Keywords is empty, so fill it up
                   3985:     #   Make sure the file we need exists...
                   3986:     if (! -e $thesaurus_db_file) {
                   3987:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3988:                                  " failed because it does not exist");
                   3989:         return 0;
                   3990:     }
                   3991:     #   Set up the hash as a database
                   3992:     my %thesaurus_db;
                   3993:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3994:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3995:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3996:                                  $thesaurus_db_file);
                   3997:         return 0;
                   3998:     } 
                   3999:     #  Get the average number of appearances of a word.
                   4000:     my $avecount = $thesaurus_db{'average.count'};
                   4001:     #  Put keywords (those that appear > average) into %Keywords
                   4002:     while (my ($word,$data)=each (%thesaurus_db)) {
                   4003:         my ($count,undef) = split /:/,$data;
                   4004:         $Keywords{$word}++ if ($count > $avecount);
                   4005:     }
                   4006:     untie %thesaurus_db;
                   4007:     # Remove special values from %Keywords.
1.356     albertel 4008:     foreach my $value ('total.count','average.count') {
                   4009:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  4010:   }
1.46      matthew  4011:     return 1;
                   4012: }
                   4013: 
                   4014: ###################################################
                   4015: 
                   4016: =pod
                   4017: 
1.648     raeburn  4018: =item * &keyword($word)
1.46      matthew  4019: 
                   4020: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   4021: than the average number of times in the thesaurus database.  Calls 
                   4022: &initialize_keywords
                   4023: 
                   4024: =cut
                   4025: 
                   4026: ###################################################
1.20      www      4027: 
                   4028: sub keyword {
1.46      matthew  4029:     return if (!&initialize_keywords());
                   4030:     my $word=lc(shift());
                   4031:     $word=~s/\W//g;
                   4032:     return exists($Keywords{$word});
1.20      www      4033: }
1.46      matthew  4034: 
                   4035: ###############################################################
                   4036: 
                   4037: =pod 
1.20      www      4038: 
1.648     raeburn  4039: =item * &get_related_words()
1.46      matthew  4040: 
1.160     matthew  4041: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  4042: an array of words.  If the keyword is not in the thesaurus, an empty array
                   4043: will be returned.  The order of the words returned is determined by the
                   4044: database which holds them.
                   4045: 
                   4046: Uses global $thesaurus_db_file.
                   4047: 
1.1057    foxr     4048: 
1.46      matthew  4049: =cut
                   4050: 
                   4051: ###############################################################
                   4052: sub get_related_words {
                   4053:     my $keyword = shift;
                   4054:     my %thesaurus_db;
                   4055:     if (! -e $thesaurus_db_file) {
                   4056:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   4057:                                  "failed because the file does not exist");
                   4058:         return ();
                   4059:     }
                   4060:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 4061:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  4062:         return ();
                   4063:     } 
                   4064:     my @Words=();
1.429     www      4065:     my $count=0;
1.46      matthew  4066:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 4067: 	# The first element is the number of times
                   4068: 	# the word appears.  We do not need it now.
1.429     www      4069: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   4070: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   4071: 	my $threshold=$mostfrequentcount/10;
                   4072:         foreach my $possibleword (@RelatedWords) {
                   4073:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   4074:             if ($wordcount>$threshold) {
                   4075: 		push(@Words,$word);
                   4076:                 $count++;
                   4077:                 if ($count>10) { last; }
                   4078: 	    }
1.20      www      4079:         }
                   4080:     }
1.46      matthew  4081:     untie %thesaurus_db;
                   4082:     return @Words;
1.14      harris41 4083: }
1.1090    foxr     4084: ###############################################################
                   4085: #
                   4086: #  Spell checking
                   4087: #
                   4088: 
                   4089: =pod
                   4090: 
1.1142    raeburn  4091: =back
                   4092: 
1.1090    foxr     4093: =head1 Spell checking
                   4094: 
                   4095: =over 4
                   4096: 
                   4097: =item * &check_spelling($wordlist $language)
                   4098: 
                   4099: Takes a string containing words and feeds it to an external
                   4100: spellcheck program via a pipeline. Returns a string containing
                   4101: them mis-spelled words.
                   4102: 
                   4103: Parameters:
                   4104: 
                   4105: =over 4
                   4106: 
                   4107: =item - $wordlist
                   4108: 
                   4109: String that will be fed into the spellcheck program.
                   4110: 
                   4111: =item - $language
                   4112: 
                   4113: Language string that specifies the language for which the spell
                   4114: check will be performed.
                   4115: 
                   4116: =back
                   4117: 
                   4118: =back
                   4119: 
                   4120: Note: This sub assumes that aspell is installed.
                   4121: 
                   4122: 
                   4123: =cut
                   4124: 
1.46      matthew  4125: 
1.1090    foxr     4126: sub check_spelling {
                   4127:     my ($wordlist, $language) = @_;
1.1091    foxr     4128:     my @misspellings;
                   4129:     
                   4130:     # Generate the speller and set the langauge.
                   4131:     # if explicitly selected:
1.1090    foxr     4132: 
1.1091    foxr     4133:     my $speller = Text::Aspell->new;
1.1090    foxr     4134:     if ($language) {
1.1091    foxr     4135: 	$speller->set_option('lang', $language);
1.1090    foxr     4136:     }
                   4137: 
1.1091    foxr     4138:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     4139: 
1.1091    foxr     4140:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     4141: 
1.1091    foxr     4142:     foreach my $word (@words) {
                   4143: 	if(! $speller->check($word)) {
                   4144: 	    push(@misspellings, $word);
1.1090    foxr     4145: 	}
                   4146:     }
1.1091    foxr     4147:     return join(' ', @misspellings);
                   4148:     
1.1090    foxr     4149: }
                   4150: 
1.61      www      4151: # -------------------------------------------------------------- Plaintext name
1.81      albertel 4152: =pod
                   4153: 
1.112     bowersj2 4154: =head1 User Name Functions
                   4155: 
                   4156: =over 4
                   4157: 
1.648     raeburn  4158: =item * &plainname($uname,$udom,$first)
1.81      albertel 4159: 
1.112     bowersj2 4160: Takes a users logon name and returns it as a string in
1.226     albertel 4161: "first middle last generation" form 
                   4162: if $first is set to 'lastname' then it returns it as
                   4163: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 4164: 
                   4165: =cut
1.61      www      4166: 
1.295     www      4167: 
1.81      albertel 4168: ###############################################################
1.61      www      4169: sub plainname {
1.226     albertel 4170:     my ($uname,$udom,$first)=@_;
1.537     albertel 4171:     return if (!defined($uname) || !defined($udom));
1.295     www      4172:     my %names=&getnames($uname,$udom);
1.226     albertel 4173:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   4174: 					  $names{'middlename'},
                   4175: 					  $names{'lastname'},
                   4176: 					  $names{'generation'},$first);
                   4177:     $name=~s/^\s+//;
1.62      www      4178:     $name=~s/\s+$//;
                   4179:     $name=~s/\s+/ /g;
1.353     albertel 4180:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      4181:     return $name;
1.61      www      4182: }
1.66      www      4183: 
                   4184: # -------------------------------------------------------------------- Nickname
1.81      albertel 4185: =pod
                   4186: 
1.648     raeburn  4187: =item * &nickname($uname,$udom)
1.81      albertel 4188: 
                   4189: Gets a users name and returns it as a string as
                   4190: 
                   4191: "&quot;nickname&quot;"
1.66      www      4192: 
1.81      albertel 4193: if the user has a nickname or
                   4194: 
                   4195: "first middle last generation"
                   4196: 
                   4197: if the user does not
                   4198: 
                   4199: =cut
1.66      www      4200: 
                   4201: sub nickname {
                   4202:     my ($uname,$udom)=@_;
1.537     albertel 4203:     return if (!defined($uname) || !defined($udom));
1.295     www      4204:     my %names=&getnames($uname,$udom);
1.68      albertel 4205:     my $name=$names{'nickname'};
1.66      www      4206:     if ($name) {
                   4207:        $name='&quot;'.$name.'&quot;'; 
                   4208:     } else {
                   4209:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   4210: 	     $names{'lastname'}.' '.$names{'generation'};
                   4211:        $name=~s/\s+$//;
                   4212:        $name=~s/\s+/ /g;
                   4213:     }
                   4214:     return $name;
                   4215: }
                   4216: 
1.295     www      4217: sub getnames {
                   4218:     my ($uname,$udom)=@_;
1.537     albertel 4219:     return if (!defined($uname) || !defined($udom));
1.433     albertel 4220:     if ($udom eq 'public' && $uname eq 'public') {
                   4221: 	return ('lastname' => &mt('Public'));
                   4222:     }
1.295     www      4223:     my $id=$uname.':'.$udom;
                   4224:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   4225:     if ($cached) {
                   4226: 	return %{$names};
                   4227:     } else {
                   4228: 	my %loadnames=&Apache::lonnet::get('environment',
                   4229:                     ['firstname','middlename','lastname','generation','nickname'],
                   4230: 					 $udom,$uname);
                   4231: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   4232: 	return %loadnames;
                   4233:     }
                   4234: }
1.61      www      4235: 
1.542     raeburn  4236: # -------------------------------------------------------------------- getemails
1.648     raeburn  4237: 
1.542     raeburn  4238: =pod
                   4239: 
1.648     raeburn  4240: =item * &getemails($uname,$udom)
1.542     raeburn  4241: 
                   4242: Gets a user's email information and returns it as a hash with keys:
                   4243: notification, critnotification, permanentemail
                   4244: 
                   4245: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  4246: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  4247:  
1.648     raeburn  4248: 
1.542     raeburn  4249: =cut
                   4250: 
1.648     raeburn  4251: 
1.466     albertel 4252: sub getemails {
                   4253:     my ($uname,$udom)=@_;
                   4254:     if ($udom eq 'public' && $uname eq 'public') {
                   4255: 	return;
                   4256:     }
1.467     www      4257:     if (!$udom) { $udom=$env{'user.domain'}; }
                   4258:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 4259:     my $id=$uname.':'.$udom;
                   4260:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   4261:     if ($cached) {
                   4262: 	return %{$names};
                   4263:     } else {
                   4264: 	my %loadnames=&Apache::lonnet::get('environment',
                   4265:                     			   ['notification','critnotification',
                   4266: 					    'permanentemail'],
                   4267: 					   $udom,$uname);
                   4268: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   4269: 	return %loadnames;
                   4270:     }
                   4271: }
                   4272: 
1.551     albertel 4273: sub flush_email_cache {
                   4274:     my ($uname,$udom)=@_;
                   4275:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4276:     if (!$uname) { $uname=$env{'user.name'};   }
                   4277:     return if ($udom eq 'public' && $uname eq 'public');
                   4278:     my $id=$uname.':'.$udom;
                   4279:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   4280: }
                   4281: 
1.728     raeburn  4282: # -------------------------------------------------------------------- getlangs
                   4283: 
                   4284: =pod
                   4285: 
                   4286: =item * &getlangs($uname,$udom)
                   4287: 
                   4288: Gets a user's language preference and returns it as a hash with key:
                   4289: language.
                   4290: 
                   4291: =cut
                   4292: 
                   4293: 
                   4294: sub getlangs {
                   4295:     my ($uname,$udom) = @_;
                   4296:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4297:     if (!$uname) { $uname=$env{'user.name'};   }
                   4298:     my $id=$uname.':'.$udom;
                   4299:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   4300:     if ($cached) {
                   4301:         return %{$langs};
                   4302:     } else {
                   4303:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   4304:                                            $udom,$uname);
                   4305:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   4306:         return %loadlangs;
                   4307:     }
                   4308: }
                   4309: 
                   4310: sub flush_langs_cache {
                   4311:     my ($uname,$udom)=@_;
                   4312:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4313:     if (!$uname) { $uname=$env{'user.name'};   }
                   4314:     return if ($udom eq 'public' && $uname eq 'public');
                   4315:     my $id=$uname.':'.$udom;
                   4316:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   4317: }
                   4318: 
1.61      www      4319: # ------------------------------------------------------------------ Screenname
1.81      albertel 4320: 
                   4321: =pod
                   4322: 
1.648     raeburn  4323: =item * &screenname($uname,$udom)
1.81      albertel 4324: 
                   4325: Gets a users screenname and returns it as a string
                   4326: 
                   4327: =cut
1.61      www      4328: 
                   4329: sub screenname {
                   4330:     my ($uname,$udom)=@_;
1.258     albertel 4331:     if ($uname eq $env{'user.name'} &&
                   4332: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 4333:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 4334:     return $names{'screenname'};
1.62      www      4335: }
                   4336: 
1.212     albertel 4337: 
1.802     bisitz   4338: # ------------------------------------------------------------- Confirm Wrapper
                   4339: =pod
                   4340: 
1.1142    raeburn  4341: =item * &confirmwrapper($message)
1.802     bisitz   4342: 
                   4343: Wrap messages about completion of operation in box
                   4344: 
                   4345: =cut
                   4346: 
                   4347: sub confirmwrapper {
                   4348:     my ($message)=@_;
                   4349:     if ($message) {
                   4350:         return "\n".'<div class="LC_confirm_box">'."\n"
                   4351:                .$message."\n"
                   4352:                .'</div>'."\n";
                   4353:     } else {
                   4354:         return $message;
                   4355:     }
                   4356: }
                   4357: 
1.62      www      4358: # ------------------------------------------------------------- Message Wrapper
                   4359: 
                   4360: sub messagewrapper {
1.369     www      4361:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      4362:     return 
1.441     albertel 4363:         '<a href="/adm/email?compose=individual&amp;'.
                   4364:         'recname='.$username.'&amp;recdom='.$domain.
                   4365: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  4366:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      4367: }
1.802     bisitz   4368: 
1.74      www      4369: # --------------------------------------------------------------- Notes Wrapper
                   4370: 
                   4371: sub noteswrapper {
                   4372:     my ($link,$un,$do)=@_;
                   4373:     return 
1.896     amueller 4374: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      4375: }
1.802     bisitz   4376: 
1.62      www      4377: # ------------------------------------------------------------- Aboutme Wrapper
                   4378: 
                   4379: sub aboutmewrapper {
1.1070    raeburn  4380:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  4381:     if (!defined($username)  && !defined($domain)) {
                   4382:         return;
                   4383:     }
1.1096    raeburn  4384:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  4385: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      4386: }
                   4387: 
                   4388: # ------------------------------------------------------------ Syllabus Wrapper
                   4389: 
                   4390: sub syllabuswrapper {
1.707     bisitz   4391:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  4392:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      4393: }
1.14      harris41 4394: 
1.1397    raeburn  4395: # -----------------------------------------------------------------------------
                   4396: 
1.1396    raeburn  4397: sub aboutme_on {
                   4398:     my ($uname,$udom)=@_;
                   4399:     unless ($uname) { $uname=$env{'user.name'}; }
                   4400:     unless ($udom)  { $udom=$env{'user.domain'}; }
                   4401:     return if ($udom eq 'public' && $uname eq 'public');
                   4402:     my $hashkey=$uname.':'.$udom;
                   4403:     my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
                   4404:     if ($cached) {
                   4405:         return $aboutme;
                   4406:     }
                   4407:     $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
                   4408:     &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
                   4409:     return $aboutme;
                   4410: }
                   4411: 
                   4412: sub devalidate_aboutme_cache {
                   4413:     my ($uname,$udom)=@_;
                   4414:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4415:     if (!$uname) { $uname=$env{'user.name'};   }
                   4416:     return if ($udom eq 'public' && $uname eq 'public');
                   4417:     my $id=$uname.':'.$udom;
                   4418:     &Apache::lonnet::devalidate_cache_new('aboutme',$id);
                   4419: }
                   4420: 
1.208     matthew  4421: sub track_student_link {
1.887     raeburn  4422:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 4423:     my $link ="/adm/trackstudent?";
1.208     matthew  4424:     my $title = 'View recent activity';
                   4425:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   4426:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 4427:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  4428:         $title .= ' of this student';
1.268     albertel 4429:     } 
1.208     matthew  4430:     if (defined($target) && $target !~ /^\s*$/) {
                   4431:         $target = qq{target="$target"};
                   4432:     } else {
                   4433:         $target = '';
                   4434:     }
1.268     albertel 4435:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  4436:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 4437:     $title = &mt($title);
                   4438:     $linktext = &mt($linktext);
1.448     albertel 4439:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   4440: 	&help_open_topic('View_recent_activity');
1.208     matthew  4441: }
                   4442: 
1.781     raeburn  4443: sub slot_reservations_link {
                   4444:     my ($linktext,$sname,$sdom,$target) = @_;
                   4445:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   4446:     my $title = 'View slot reservation history';
                   4447:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   4448:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   4449:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   4450:         $title .= ' of this student';
                   4451:     }
                   4452:     if (defined($target) && $target !~ /^\s*$/) {
                   4453:         $target = qq{target="$target"};
                   4454:     } else {
                   4455:         $target = '';
                   4456:     }
                   4457:     $title = &mt($title);
                   4458:     $linktext = &mt($linktext);
                   4459:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   4460: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   4461: 
                   4462: }
                   4463: 
1.508     www      4464: # ===================================================== Display a student photo
                   4465: 
                   4466: 
1.509     albertel 4467: sub student_image_tag {
1.508     www      4468:     my ($domain,$user)=@_;
                   4469:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   4470:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   4471: 	return '<img src="'.$imgsrc.'" align="right" />';
                   4472:     } else {
                   4473: 	return '';
                   4474:     }
                   4475: }
                   4476: 
1.112     bowersj2 4477: =pod
                   4478: 
                   4479: =back
                   4480: 
                   4481: =head1 Access .tab File Data
                   4482: 
                   4483: =over 4
                   4484: 
1.648     raeburn  4485: =item * &languageids() 
1.112     bowersj2 4486: 
                   4487: returns list of all language ids
                   4488: 
                   4489: =cut
                   4490: 
1.14      harris41 4491: sub languageids {
1.16      harris41 4492:     return sort(keys(%language));
1.14      harris41 4493: }
                   4494: 
1.112     bowersj2 4495: =pod
                   4496: 
1.648     raeburn  4497: =item * &languagedescription() 
1.112     bowersj2 4498: 
                   4499: returns description of a specified language id
                   4500: 
                   4501: =cut
                   4502: 
1.14      harris41 4503: sub languagedescription {
1.125     www      4504:     my $code=shift;
                   4505:     return  ($supported_language{$code}?'* ':'').
                   4506:             $language{$code}.
1.126     www      4507: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      4508: }
                   4509: 
1.1048    foxr     4510: =pod
                   4511: 
                   4512: =item * &plainlanguagedescription
                   4513: 
                   4514: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   4515: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   4516: 
                   4517: =cut
                   4518: 
1.145     www      4519: sub plainlanguagedescription {
                   4520:     my $code=shift;
                   4521:     return $language{$code};
                   4522: }
                   4523: 
1.1048    foxr     4524: =pod
                   4525: 
                   4526: =item * &supportedlanguagecode
                   4527: 
                   4528: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   4529: code.
                   4530: 
                   4531: =cut
                   4532: 
1.145     www      4533: sub supportedlanguagecode {
                   4534:     my $code=shift;
                   4535:     return $supported_language{$code};
1.97      www      4536: }
                   4537: 
1.112     bowersj2 4538: =pod
                   4539: 
1.1048    foxr     4540: =item * &latexlanguage()
                   4541: 
                   4542: Given a language key code returns the correspondnig language to use
                   4543: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   4544: is no supported hyphenation for the language code.
                   4545: 
                   4546: =cut
                   4547: 
                   4548: sub latexlanguage {
                   4549:     my $code = shift;
                   4550:     return $latex_language{$code};
                   4551: }
                   4552: 
                   4553: =pod
                   4554: 
                   4555: =item * &latexhyphenation()
                   4556: 
                   4557: Same as above but what's supplied is the language as it might be stored
                   4558: in the metadata.
                   4559: 
                   4560: =cut
                   4561: 
                   4562: sub latexhyphenation {
                   4563:     my $key = shift;
                   4564:     return $latex_language_bykey{$key};
                   4565: }
                   4566: 
                   4567: =pod
                   4568: 
1.648     raeburn  4569: =item * &copyrightids() 
1.112     bowersj2 4570: 
                   4571: returns list of all copyrights
                   4572: 
                   4573: =cut
                   4574: 
                   4575: sub copyrightids {
                   4576:     return sort(keys(%cprtag));
                   4577: }
                   4578: 
                   4579: =pod
                   4580: 
1.648     raeburn  4581: =item * &copyrightdescription() 
1.112     bowersj2 4582: 
                   4583: returns description of a specified copyright id
                   4584: 
                   4585: =cut
                   4586: 
                   4587: sub copyrightdescription {
1.166     www      4588:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 4589: }
1.197     matthew  4590: 
                   4591: =pod
                   4592: 
1.648     raeburn  4593: =item * &source_copyrightids() 
1.192     taceyjo1 4594: 
                   4595: returns list of all source copyrights
                   4596: 
                   4597: =cut
                   4598: 
                   4599: sub source_copyrightids {
                   4600:     return sort(keys(%scprtag));
                   4601: }
                   4602: 
                   4603: =pod
                   4604: 
1.648     raeburn  4605: =item * &source_copyrightdescription() 
1.192     taceyjo1 4606: 
                   4607: returns description of a specified source copyright id
                   4608: 
                   4609: =cut
                   4610: 
                   4611: sub source_copyrightdescription {
                   4612:     return &mt($scprtag{shift(@_)});
                   4613: }
1.112     bowersj2 4614: 
                   4615: =pod
                   4616: 
1.648     raeburn  4617: =item * &filecategories() 
1.112     bowersj2 4618: 
                   4619: returns list of all file categories
                   4620: 
                   4621: =cut
                   4622: 
                   4623: sub filecategories {
                   4624:     return sort(keys(%category_extensions));
                   4625: }
                   4626: 
                   4627: =pod
                   4628: 
1.648     raeburn  4629: =item * &filecategorytypes() 
1.112     bowersj2 4630: 
                   4631: returns list of file types belonging to a given file
                   4632: category
                   4633: 
                   4634: =cut
                   4635: 
                   4636: sub filecategorytypes {
1.356     albertel 4637:     my ($cat) = @_;
1.1248    raeburn  4638:     if (ref($category_extensions{lc($cat)}) eq 'ARRAY') { 
                   4639:         return @{$category_extensions{lc($cat)}};
                   4640:     } else {
                   4641:         return ();
                   4642:     }
1.112     bowersj2 4643: }
                   4644: 
                   4645: =pod
                   4646: 
1.648     raeburn  4647: =item * &fileembstyle() 
1.112     bowersj2 4648: 
                   4649: returns embedding style for a specified file type
                   4650: 
                   4651: =cut
                   4652: 
                   4653: sub fileembstyle {
                   4654:     return $fe{lc(shift(@_))};
1.169     www      4655: }
                   4656: 
1.351     www      4657: sub filemimetype {
                   4658:     return $fm{lc(shift(@_))};
                   4659: }
                   4660: 
1.169     www      4661: 
                   4662: sub filecategoryselect {
                   4663:     my ($name,$value)=@_;
1.189     matthew  4664:     return &select_form($value,$name,
1.970     raeburn  4665:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 4666: }
                   4667: 
                   4668: =pod
                   4669: 
1.648     raeburn  4670: =item * &filedescription() 
1.112     bowersj2 4671: 
                   4672: returns description for a specified file type
                   4673: 
                   4674: =cut
                   4675: 
                   4676: sub filedescription {
1.188     matthew  4677:     my $file_description = $fd{lc(shift())};
                   4678:     $file_description =~ s:([\[\]]):~$1:g;
                   4679:     return &mt($file_description);
1.112     bowersj2 4680: }
                   4681: 
                   4682: =pod
                   4683: 
1.648     raeburn  4684: =item * &filedescriptionex() 
1.112     bowersj2 4685: 
                   4686: returns description for a specified file type with
                   4687: extra formatting
                   4688: 
                   4689: =cut
                   4690: 
                   4691: sub filedescriptionex {
                   4692:     my $ex=shift;
1.188     matthew  4693:     my $file_description = $fd{lc($ex)};
                   4694:     $file_description =~ s:([\[\]]):~$1:g;
                   4695:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 4696: }
                   4697: 
                   4698: # End of .tab access
                   4699: =pod
                   4700: 
                   4701: =back
                   4702: 
                   4703: =cut
                   4704: 
                   4705: # ------------------------------------------------------------------ File Types
                   4706: sub fileextensions {
                   4707:     return sort(keys(%fe));
                   4708: }
                   4709: 
1.97      www      4710: # ----------------------------------------------------------- Display Languages
                   4711: # returns a hash with all desired display languages
                   4712: #
                   4713: 
                   4714: sub display_languages {
                   4715:     my %languages=();
1.695     raeburn  4716:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 4717: 	$languages{$lang}=1;
1.97      www      4718:     }
                   4719:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 4720:     if ($env{'form.displaylanguage'}) {
1.356     albertel 4721: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   4722: 	    $languages{$lang}=1;
1.97      www      4723:         }
                   4724:     }
                   4725:     return %languages;
1.14      harris41 4726: }
                   4727: 
1.582     albertel 4728: sub languages {
                   4729:     my ($possible_langs) = @_;
1.695     raeburn  4730:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 4731:     if (!ref($possible_langs)) {
                   4732: 	if( wantarray ) {
                   4733: 	    return @preferred_langs;
                   4734: 	} else {
                   4735: 	    return $preferred_langs[0];
                   4736: 	}
                   4737:     }
                   4738:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   4739:     my @preferred_possibilities;
                   4740:     foreach my $preferred_lang (@preferred_langs) {
                   4741: 	if (exists($possibilities{$preferred_lang})) {
                   4742: 	    push(@preferred_possibilities, $preferred_lang);
                   4743: 	}
                   4744:     }
                   4745:     if( wantarray ) {
                   4746: 	return @preferred_possibilities;
                   4747:     }
                   4748:     return $preferred_possibilities[0];
                   4749: }
                   4750: 
1.742     raeburn  4751: sub user_lang {
                   4752:     my ($touname,$toudom,$fromcid) = @_;
                   4753:     my @userlangs;
                   4754:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   4755:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   4756:                     $env{'course.'.$fromcid.'.languages'}));
                   4757:     } else {
                   4758:         my %langhash = &getlangs($touname,$toudom);
                   4759:         if ($langhash{'languages'} ne '') {
                   4760:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   4761:         } else {
                   4762:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   4763:             if ($domdefs{'lang_def'} ne '') {
                   4764:                 @userlangs = ($domdefs{'lang_def'});
                   4765:             }
                   4766:         }
                   4767:     }
                   4768:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4769:     my $user_lh = Apache::localize->get_handle(@languages);
                   4770:     return $user_lh;
                   4771: }
                   4772: 
                   4773: 
1.112     bowersj2 4774: ###############################################################
                   4775: ##               Student Answer Attempts                     ##
                   4776: ###############################################################
                   4777: 
                   4778: =pod
                   4779: 
                   4780: =head1 Alternate Problem Views
                   4781: 
                   4782: =over 4
                   4783: 
1.648     raeburn  4784: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199    raeburn  4785:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4786: 
                   4787: Return string with previous attempt on problem. Arguments:
                   4788: 
                   4789: =over 4
                   4790: 
                   4791: =item * $symb: Problem, including path
                   4792: 
                   4793: =item * $username: username of the desired student
                   4794: 
                   4795: =item * $domain: domain of the desired student
1.14      harris41 4796: 
1.112     bowersj2 4797: =item * $course: Course ID
1.14      harris41 4798: 
1.112     bowersj2 4799: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4800:     something
1.14      harris41 4801: 
1.112     bowersj2 4802: =item * $regexp: if string matches this regexp, the string will be
                   4803:     sent to $gradesub
1.14      harris41 4804: 
1.112     bowersj2 4805: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4806: 
1.1199    raeburn  4807: =item * $usec: section of the desired student
                   4808: 
                   4809: =item * $identifier: counter for student (multiple students one problem) or 
                   4810:     problem (one student; whole sequence).
                   4811: 
1.112     bowersj2 4812: =back
1.14      harris41 4813: 
1.112     bowersj2 4814: The output string is a table containing all desired attempts, if any.
1.16      harris41 4815: 
1.112     bowersj2 4816: =cut
1.1       albertel 4817: 
                   4818: sub get_previous_attempt {
1.1199    raeburn  4819:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4820:   my $prevattempts='';
1.43      ng       4821:   no strict 'refs';
1.1       albertel 4822:   if ($symb) {
1.3       albertel 4823:     my (%returnhash)=
                   4824:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4825:     if ($returnhash{'version'}) {
                   4826:       my %lasthash=();
                   4827:       my $version;
                   4828:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212    raeburn  4829:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4830:             if ($key =~ /\.rawrndseed$/) {
                   4831:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4832:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4833:             } else {
                   4834:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4835:             }
1.19      harris41 4836:         }
1.1       albertel 4837:       }
1.596     albertel 4838:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4839:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1199    raeburn  4840:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4841:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4842:       foreach my $key (sort(keys(%lasthash))) {
                   4843: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4844: 	if ($#parts > 0) {
1.31      albertel 4845: 	  my $data=$parts[-1];
1.989     raeburn  4846:           next if ($data eq 'foilorder');
1.31      albertel 4847: 	  pop(@parts);
1.1010    www      4848:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4849:           if ($data eq 'type') {
                   4850:               unless ($showsurv) {
                   4851:                   my $id = join(',',@parts);
                   4852:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4853:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4854:                       $lasthidden{$ign.'.'.$id} = 1;
                   4855:                   }
1.945     raeburn  4856:               }
1.1199    raeburn  4857:               if ($identifier ne '') {
                   4858:                   my $id = join(',',@parts);
                   4859:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4860:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4861:                       $hidestatus{$ign.'.'.$id} = 1;
                   4862:                   }
                   4863:               }
                   4864:           } elsif ($data eq 'regrader') {
                   4865:               if (($identifier ne '') && (@parts)) {
1.1200    raeburn  4866:                   my $id = join(',',@parts);
                   4867:                   $regraded{$ign.'.'.$id} = 1;
1.1199    raeburn  4868:               }
1.1010    www      4869:           } 
1.31      albertel 4870: 	} else {
1.41      ng       4871: 	  if ($#parts == 0) {
                   4872: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4873: 	  } else {
                   4874: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4875: 	  }
1.31      albertel 4876: 	}
1.16      harris41 4877:       }
1.596     albertel 4878:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4879:       if ($getattempt eq '') {
1.1199    raeburn  4880:         my (%solved,%resets,%probstatus);
1.1200    raeburn  4881:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4882:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4883:                 foreach my $id (keys(%regraded)) {
                   4884:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4885:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4886:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4887:                         push(@{$resets{$id}},$version);
1.1199    raeburn  4888:                     }
                   4889:                 }
                   4890:             }
1.1200    raeburn  4891:         }
                   4892: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199    raeburn  4893:             my (@hidden,@unsolved);
1.945     raeburn  4894:             if (%typeparts) {
                   4895:                 foreach my $id (keys(%typeparts)) {
1.1199    raeburn  4896:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                   4897:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4898:                         push(@hidden,$id);
1.1199    raeburn  4899:                     } elsif ($identifier ne '') {
                   4900:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4901:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4902:                                 ($hidestatus{$id})) {
1.1200    raeburn  4903:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199    raeburn  4904:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4905:                                 push(@{$solved{$id}},$version);
                   4906:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4907:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4908:                                 my $skip;
                   4909:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4910:                                     foreach my $reset (@{$resets{$id}}) {
                   4911:                                         if ($reset > $solved{$id}[-1]) {
                   4912:                                             $skip=1;
                   4913:                                             last;
                   4914:                                         }
                   4915:                                     }
                   4916:                                 }
                   4917:                                 unless ($skip) {
                   4918:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4919:                                     push(@unsolved,$partslist);
                   4920:                                 }
                   4921:                             }
                   4922:                         }
1.945     raeburn  4923:                     }
                   4924:                 }
                   4925:             }
                   4926:             $prevattempts.=&start_data_table_row().
1.1199    raeburn  4927:                            '<td>'.&mt('Transaction [_1]',$version);
                   4928:             if (@unsolved) {
                   4929:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4930:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4931:                                  &mt('Hide').'</label></span>';
                   4932:             }
                   4933:             $prevattempts .= '</td>';
1.945     raeburn  4934:             if (@hidden) {
                   4935:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4936:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4937:                     my $hide;
                   4938:                     foreach my $id (@hidden) {
                   4939:                         if ($key =~ /^\Q$id\E/) {
                   4940:                             $hide = 1;
                   4941:                             last;
                   4942:                         }
                   4943:                     }
                   4944:                     if ($hide) {
                   4945:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4946:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4947:                             my $value = &format_previous_attempt_value($key,
                   4948:                                              $returnhash{$version.':'.$key});
1.1173    kruse    4949:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4950:                         } else {
                   4951:                             $prevattempts.='<td>&nbsp;</td>';
                   4952:                         }
                   4953:                     } else {
                   4954:                         if ($key =~ /\./) {
1.1212    raeburn  4955:                             my $value = $returnhash{$version.':'.$key};
                   4956:                             if ($key =~ /\.rndseed$/) {
                   4957:                                 my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4958:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4959:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4960:                                 }
                   4961:                             }
                   4962:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4963:                                            '&nbsp;</td>';
1.945     raeburn  4964:                         } else {
                   4965:                             $prevattempts.='<td>&nbsp;</td>';
                   4966:                         }
                   4967:                     }
                   4968:                 }
                   4969:             } else {
                   4970: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4971:                     next if ($key =~ /\.foilorder$/);
1.1212    raeburn  4972:                     my $value = $returnhash{$version.':'.$key};
                   4973:                     if ($key =~ /\.rndseed$/) {
                   4974:                         my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4975:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4976:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4977:                         }
                   4978:                     }
                   4979:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4980:                                    '&nbsp;</td>';
1.945     raeburn  4981: 	        }
                   4982:             }
                   4983: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4984: 	 }
1.1       albertel 4985:       }
1.945     raeburn  4986:       my @currhidden = keys(%lasthidden);
1.596     albertel 4987:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4988:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4989:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4990:           if (%typeparts) {
                   4991:               my $hidden;
                   4992:               foreach my $id (@currhidden) {
                   4993:                   if ($key =~ /^\Q$id\E/) {
                   4994:                       $hidden = 1;
                   4995:                       last;
                   4996:                   }
                   4997:               }
                   4998:               if ($hidden) {
                   4999:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   5000:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   5001:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   5002:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   5003:                           $value = &$gradesub($value);
                   5004:                       }
1.1173    kruse    5005:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  5006:                   } else {
                   5007:                       $prevattempts.='<td>&nbsp;</td>';
                   5008:                   }
                   5009:               } else {
                   5010:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   5011:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   5012:                       $value = &$gradesub($value);
                   5013:                   }
1.1173    kruse    5014:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  5015:               }
                   5016:           } else {
                   5017: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   5018: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   5019:                   $value = &$gradesub($value);
                   5020:               }
1.1173    kruse    5021: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  5022:           }
1.16      harris41 5023:       }
1.596     albertel 5024:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 5025:     } else {
1.1305    raeburn  5026:       my $msg;
                   5027:       if ($symb =~ /ext\.tool$/) {
                   5028:           $msg = &mt('No grade passed back.');
                   5029:       } else {
                   5030:           $msg = &mt('Nothing submitted - no attempts.');
                   5031:       }
1.596     albertel 5032:       $prevattempts=
                   5033: 	  &start_data_table().&start_data_table_row().
1.1305    raeburn  5034: 	  '<td>'.$msg.'</td>'.
1.596     albertel 5035: 	  &end_data_table_row().&end_data_table();
1.1       albertel 5036:     }
                   5037:   } else {
1.596     albertel 5038:     $prevattempts=
                   5039: 	  &start_data_table().&start_data_table_row().
                   5040: 	  '<td>'.&mt('No data.').'</td>'.
                   5041: 	  &end_data_table_row().&end_data_table();
1.1       albertel 5042:   }
1.10      albertel 5043: }
                   5044: 
1.581     albertel 5045: sub format_previous_attempt_value {
                   5046:     my ($key,$value) = @_;
1.1011    www      5047:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    5048:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 5049:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    5050:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  5051:     } elsif ($key =~ /answerstring$/) {
                   5052:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    5053:         my @answer = %answers;
                   5054:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  5055:         my @anskeys = sort(keys(%answers));
                   5056:         if (@anskeys == 1) {
                   5057:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  5058:             if ($answer =~ m{\0}) {
                   5059:                 $answer =~ s{\0}{,}g;
1.988     raeburn  5060:             }
                   5061:             my $tag_internal_answer_name = 'INTERNAL';
                   5062:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   5063:                 $value = $answer; 
                   5064:             } else {
                   5065:                 $value = $anskeys[0].'='.$answer;
                   5066:             }
                   5067:         } else {
                   5068:             foreach my $ans (@anskeys) {
                   5069:                 my $answer = $answers{$ans};
1.1001    raeburn  5070:                 if ($answer =~ m{\0}) {
                   5071:                     $answer =~ s{\0}{,}g;
1.988     raeburn  5072:                 }
                   5073:                 $value .=  $ans.'='.$answer.'<br />';;
                   5074:             } 
                   5075:         }
1.581     albertel 5076:     } else {
1.1173    kruse    5077:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 5078:     }
                   5079:     return $value;
                   5080: }
                   5081: 
                   5082: 
1.107     albertel 5083: sub relative_to_absolute {
                   5084:     my ($url,$output)=@_;
                   5085:     my $parser=HTML::TokeParser->new(\$output);
                   5086:     my $token;
                   5087:     my $thisdir=$url;
                   5088:     my @rlinks=();
                   5089:     while ($token=$parser->get_token) {
                   5090: 	if ($token->[0] eq 'S') {
                   5091: 	    if ($token->[1] eq 'a') {
                   5092: 		if ($token->[2]->{'href'}) {
                   5093: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   5094: 		}
                   5095: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   5096: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   5097: 	    } elsif ($token->[1] eq 'base') {
                   5098: 		$thisdir=$token->[2]->{'href'};
                   5099: 	    }
                   5100: 	}
                   5101:     }
                   5102:     $thisdir=~s-/[^/]*$--;
1.356     albertel 5103:     foreach my $link (@rlinks) {
1.726     raeburn  5104: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 5105: 		($link=~/^\//) ||
                   5106: 		($link=~/^javascript:/i) ||
                   5107: 		($link=~/^mailto:/i) ||
                   5108: 		($link=~/^\#/)) {
                   5109: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   5110: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 5111: 	}
                   5112:     }
                   5113: # -------------------------------------------------- Deal with Applet codebases
                   5114:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   5115:     return $output;
                   5116: }
                   5117: 
1.112     bowersj2 5118: =pod
                   5119: 
1.648     raeburn  5120: =item * &get_student_view()
1.112     bowersj2 5121: 
                   5122: show a snapshot of what student was looking at
                   5123: 
                   5124: =cut
                   5125: 
1.10      albertel 5126: sub get_student_view {
1.186     albertel 5127:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      5128:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 5129:   my (%form);
1.10      albertel 5130:   my @elements=('symb','courseid','domain','username');
                   5131:   foreach my $element (@elements) {
1.186     albertel 5132:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 5133:   }
1.186     albertel 5134:   if (defined($moreenv)) {
                   5135:       %form=(%form,%{$moreenv});
                   5136:   }
1.236     albertel 5137:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 5138:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306    raeburn  5139:   if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
                   5140:       $feedurl =~ s{^/adm/wrapper}{};
                   5141:   }
1.650     www      5142:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 5143:   $userview=~s/\<body[^\>]*\>//gi;
                   5144:   $userview=~s/\<\/body\>//gi;
                   5145:   $userview=~s/\<html\>//gi;
                   5146:   $userview=~s/\<\/html\>//gi;
                   5147:   $userview=~s/\<head\>//gi;
                   5148:   $userview=~s/\<\/head\>//gi;
                   5149:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 5150:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      5151:   if (wantarray) {
                   5152:      return ($userview,$response);
                   5153:   } else {
                   5154:      return $userview;
                   5155:   }
                   5156: }
                   5157: 
                   5158: sub get_student_view_with_retries {
                   5159:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   5160: 
                   5161:     my $ok = 0;                 # True if we got a good response.
                   5162:     my $content;
                   5163:     my $response;
                   5164: 
                   5165:     # Try to get the student_view done. within the retries count:
                   5166:     
                   5167:     do {
                   5168:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   5169:          $ok      = $response->is_success;
                   5170:          if (!$ok) {
                   5171:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   5172:          }
                   5173:          $retries--;
                   5174:     } while (!$ok && ($retries > 0));
                   5175:     
                   5176:     if (!$ok) {
                   5177:        $content = '';          # On error return an empty content.
                   5178:     }
1.651     www      5179:     if (wantarray) {
                   5180:        return ($content, $response);
                   5181:     } else {
                   5182:        return $content;
                   5183:     }
1.11      albertel 5184: }
                   5185: 
1.1349    raeburn  5186: sub css_links {
                   5187:     my ($currsymb,$level) = @_;
                   5188:     my ($links,@symbs,%cssrefs,%httpref);
                   5189:     if ($level eq 'map') {
                   5190:         my $navmap = Apache::lonnavmaps::navmap->new();
                   5191:         if (ref($navmap)) {
                   5192:             my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
                   5193:             my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
                   5194:             foreach my $res (@resources) {
                   5195:                 if (ref($res) && $res->symb()) {
                   5196:                     push(@symbs,$res->symb());
                   5197:                 }
                   5198:             }
                   5199:         }
                   5200:     } else {
                   5201:         @symbs = ($currsymb);
                   5202:     }
                   5203:     foreach my $symb (@symbs) {
                   5204:         my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
                   5205:         if ($css_href =~ /\S/) {
                   5206:             unless ($css_href =~ m{https?://}) {
                   5207:                 my $url = (&Apache::lonnet::decode_symb($symb))[-1];
                   5208:                 my $proburl =  &Apache::lonnet::clutter($url);
                   5209:                 my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
                   5210:                 unless ($css_href =~ m{^/}) {
                   5211:                     $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
                   5212:                 }
                   5213:                 if ($css_href =~ m{^/(res|uploaded)/}) {
                   5214:                     unless (($httpref{'httpref.'.$css_href}) ||
                   5215:                             (&Apache::lonnet::is_on_map($css_href))) {
                   5216:                         my $thisurl = $proburl;
                   5217:                         if ($env{'httpref.'.$proburl}) {
                   5218:                             $thisurl = $env{'httpref.'.$proburl};
                   5219:                         }
                   5220:                         $httpref{'httpref.'.$css_href} = $thisurl;
                   5221:                     }
                   5222:                 }
                   5223:             }
                   5224:             $cssrefs{$css_href} = 1;
                   5225:         }
                   5226:     }
                   5227:     if (keys(%httpref)) {
                   5228:         &Apache::lonnet::appenv(\%httpref);
                   5229:     }
                   5230:     if (keys(%cssrefs)) {
                   5231:         foreach my $css_href (keys(%cssrefs)) {
                   5232:             next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
                   5233:             $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
                   5234:         }
                   5235:     }
                   5236:     return $links;
                   5237: }
                   5238: 
1.112     bowersj2 5239: =pod
                   5240: 
1.648     raeburn  5241: =item * &get_student_answers() 
1.112     bowersj2 5242: 
                   5243: show a snapshot of how student was answering problem
                   5244: 
                   5245: =cut
                   5246: 
1.11      albertel 5247: sub get_student_answers {
1.100     sakharuk 5248:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      5249:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 5250:   my (%moreenv);
1.11      albertel 5251:   my @elements=('symb','courseid','domain','username');
                   5252:   foreach my $element (@elements) {
1.186     albertel 5253:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 5254:   }
1.186     albertel 5255:   $moreenv{'grade_target'}='answer';
                   5256:   %moreenv=(%form,%moreenv);
1.497     raeburn  5257:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   5258:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 5259:   return $userview;
1.1       albertel 5260: }
1.116     albertel 5261: 
                   5262: =pod
                   5263: 
                   5264: =item * &submlink()
                   5265: 
1.242     albertel 5266: Inputs: $text $uname $udom $symb $target
1.116     albertel 5267: 
                   5268: Returns: A link to grades.pm such as to see the SUBM view of a student
                   5269: 
                   5270: =cut
                   5271: 
                   5272: ###############################################
                   5273: sub submlink {
1.242     albertel 5274:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 5275:     if (!($uname && $udom)) {
                   5276: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 5277: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 5278: 	if (!$symb) { $symb=$cursymb; }
                   5279:     }
1.254     matthew  5280:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      5281:     $symb=&escape($symb);
1.960     bisitz   5282:     if ($target) { $target=" target=\"$target\""; }
                   5283:     return
                   5284:         '<a href="/adm/grades?command=submission'.
                   5285:         '&amp;symb='.$symb.
                   5286:         '&amp;student='.$uname.
                   5287:         '&amp;userdom='.$udom.'"'.
                   5288:         $target.'>'.$text.'</a>';
1.242     albertel 5289: }
                   5290: ##############################################
                   5291: 
                   5292: =pod
                   5293: 
                   5294: =item * &pgrdlink()
                   5295: 
                   5296: Inputs: $text $uname $udom $symb $target
                   5297: 
                   5298: Returns: A link to grades.pm such as to see the PGRD view of a student
                   5299: 
                   5300: =cut
                   5301: 
                   5302: ###############################################
                   5303: sub pgrdlink {
                   5304:     my $link=&submlink(@_);
                   5305:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   5306:     return $link;
                   5307: }
                   5308: ##############################################
                   5309: 
                   5310: =pod
                   5311: 
                   5312: =item * &pprmlink()
                   5313: 
                   5314: Inputs: $text $uname $udom $symb $target
                   5315: 
                   5316: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 5317: student and a specific resource
1.242     albertel 5318: 
                   5319: =cut
                   5320: 
                   5321: ###############################################
                   5322: sub pprmlink {
                   5323:     my ($text,$uname,$udom,$symb,$target)=@_;
                   5324:     if (!($uname && $udom)) {
                   5325: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 5326: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 5327: 	if (!$symb) { $symb=$cursymb; }
                   5328:     }
1.254     matthew  5329:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      5330:     $symb=&escape($symb);
1.242     albertel 5331:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 5332:     return '<a href="/adm/parmset?command=set&amp;'.
                   5333: 	'symb='.$symb.'&amp;uname='.$uname.
                   5334: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 5335: }
                   5336: ##############################################
1.37      matthew  5337: 
1.112     bowersj2 5338: =pod
                   5339: 
                   5340: =back
                   5341: 
                   5342: =cut
                   5343: 
1.37      matthew  5344: ###############################################
1.51      www      5345: 
                   5346: 
                   5347: sub timehash {
1.687     raeburn  5348:     my ($thistime) = @_;
                   5349:     my $timezone = &Apache::lonlocal::gettimezone();
                   5350:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   5351:                      ->set_time_zone($timezone);
                   5352:     my $wday = $dt->day_of_week();
                   5353:     if ($wday == 7) { $wday = 0; }
                   5354:     return ( 'second' => $dt->second(),
                   5355:              'minute' => $dt->minute(),
                   5356:              'hour'   => $dt->hour(),
                   5357:              'day'     => $dt->day_of_month(),
                   5358:              'month'   => $dt->month(),
                   5359:              'year'    => $dt->year(),
                   5360:              'weekday' => $wday,
                   5361:              'dayyear' => $dt->day_of_year(),
                   5362:              'dlsav'   => $dt->is_dst() );
1.51      www      5363: }
                   5364: 
1.370     www      5365: sub utc_string {
                   5366:     my ($date)=@_;
1.371     www      5367:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      5368: }
                   5369: 
1.51      www      5370: sub maketime {
                   5371:     my %th=@_;
1.687     raeburn  5372:     my ($epoch_time,$timezone,$dt);
                   5373:     $timezone = &Apache::lonlocal::gettimezone();
                   5374:     eval {
                   5375:         $dt = DateTime->new( year   => $th{'year'},
                   5376:                              month  => $th{'month'},
                   5377:                              day    => $th{'day'},
                   5378:                              hour   => $th{'hour'},
                   5379:                              minute => $th{'minute'},
                   5380:                              second => $th{'second'},
                   5381:                              time_zone => $timezone,
                   5382:                          );
                   5383:     };
                   5384:     if (!$@) {
                   5385:         $epoch_time = $dt->epoch;
                   5386:         if ($epoch_time) {
                   5387:             return $epoch_time;
                   5388:         }
                   5389:     }
1.51      www      5390:     return POSIX::mktime(
                   5391:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      5392:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      5393: }
                   5394: 
                   5395: #########################################
1.51      www      5396: 
                   5397: sub findallcourses {
1.482     raeburn  5398:     my ($roles,$uname,$udom) = @_;
1.355     albertel 5399:     my %roles;
                   5400:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 5401:     my %courses;
1.51      www      5402:     my $now=time;
1.482     raeburn  5403:     if (!defined($uname)) {
                   5404:         $uname = $env{'user.name'};
                   5405:     }
                   5406:     if (!defined($udom)) {
                   5407:         $udom = $env{'user.domain'};
                   5408:     }
                   5409:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  5410:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  5411:         if (!%roles) {
                   5412:             %roles = (
                   5413:                        cc => 1,
1.907     raeburn  5414:                        co => 1,
1.482     raeburn  5415:                        in => 1,
                   5416:                        ep => 1,
                   5417:                        ta => 1,
                   5418:                        cr => 1,
                   5419:                        st => 1,
                   5420:              );
                   5421:         }
                   5422:         foreach my $entry (keys(%roleshash)) {
                   5423:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   5424:             if ($trole =~ /^cr/) { 
                   5425:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   5426:             } else {
                   5427:                 next if (!exists($roles{$trole}));
                   5428:             }
                   5429:             if ($tend) {
                   5430:                 next if ($tend < $now);
                   5431:             }
                   5432:             if ($tstart) {
                   5433:                 next if ($tstart > $now);
                   5434:             }
1.1058    raeburn  5435:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  5436:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  5437:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  5438:             if ($secpart eq '') {
                   5439:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   5440:                 $sec = 'none';
1.1058    raeburn  5441:                 $value .= $cnum.'/';
1.482     raeburn  5442:             } else {
                   5443:                 $cnum = $cnumpart;
                   5444:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  5445:                 $value .= $cnum.'/'.$sec;
                   5446:             }
                   5447:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   5448:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   5449:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   5450:                 }
                   5451:             } else {
                   5452:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  5453:             }
1.482     raeburn  5454:         }
                   5455:     } else {
                   5456:         foreach my $key (keys(%env)) {
1.483     albertel 5457: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   5458:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  5459: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   5460: 	        next if ($role eq 'ca' || $role eq 'aa');
                   5461: 	        next if (%roles && !exists($roles{$role}));
                   5462: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   5463:                 my $active=1;
                   5464:                 if ($starttime) {
                   5465: 		    if ($now<$starttime) { $active=0; }
                   5466:                 }
                   5467:                 if ($endtime) {
                   5468:                     if ($now>$endtime) { $active=0; }
                   5469:                 }
                   5470:                 if ($active) {
1.1058    raeburn  5471:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  5472:                     if ($sec eq '') {
                   5473:                         $sec = 'none';
1.1058    raeburn  5474:                     } else {
                   5475:                         $value .= $sec;
                   5476:                     }
                   5477:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   5478:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   5479:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   5480:                         }
                   5481:                     } else {
                   5482:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  5483:                     }
1.474     raeburn  5484:                 }
                   5485:             }
1.51      www      5486:         }
                   5487:     }
1.474     raeburn  5488:     return %courses;
1.51      www      5489: }
1.37      matthew  5490: 
1.54      www      5491: ###############################################
1.474     raeburn  5492: 
                   5493: sub blockcheck {
1.1372    raeburn  5494:     my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
                   5495:     unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
                   5496:         my ($has_evb,$check_ipaccess);
                   5497:         my $dom = $env{'user.domain'};
                   5498:         if ($env{'request.course.id'}) {
                   5499:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5500:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5501:             my $checkrole = "cm./$cdom/$cnum";
                   5502:             my $sec = $env{'request.course.sec'};
                   5503:             if ($sec ne '') {
                   5504:                 $checkrole .= "/$sec";
                   5505:             }
                   5506:             if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   5507:                 ($env{'request.role'} !~ /^st/)) {
                   5508:                 $has_evb = 1;
                   5509:             }
                   5510:             unless ($has_evb) {
                   5511:                 if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
                   5512:                     ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
                   5513:                     if ($udom eq $cdom) {
                   5514:                         $check_ipaccess = 1;
                   5515:                     }
                   5516:                 }
                   5517:             }
1.1375    raeburn  5518:         } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
                   5519:                 ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
                   5520:             my $checkrole;
                   5521:             if ($env{'request.role.domain'} eq '') {
                   5522:                 $checkrole = "cm./$env{'user.domain'}/";
                   5523:             } else {
                   5524:                 $checkrole = "cm./$env{'request.role.domain'}/";
                   5525:             }
                   5526:             if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
                   5527:                 $has_evb = 1;
                   5528:             }
1.1372    raeburn  5529:         }
                   5530:         unless ($has_evb || $check_ipaccess) {
                   5531:             my @machinedoms = &Apache::lonnet::current_machine_domains();
                   5532:             if (($dom eq 'public') && ($activity eq 'port')) {
                   5533:                 $dom = $udom;
                   5534:             }
                   5535:             if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
                   5536:                 $check_ipaccess = 1;
                   5537:             } else {
                   5538:                 my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   5539:                 my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
                   5540:                 my $prim = &Apache::lonnet::domain($dom,'primary');
                   5541:                 my $intdom = &Apache::lonnet::internet_dom($prim);
                   5542:                 if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
                   5543:                     if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
                   5544:                         $check_ipaccess = 1;
                   5545:                     }
                   5546:                 }
                   5547:             }
                   5548:         }
                   5549:         if ($check_ipaccess) {
                   5550:             my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
                   5551:             unless (defined($cached)) {
                   5552:                 my %domconfig =
                   5553:                     &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
                   5554:                 $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
                   5555:             }
                   5556:             if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
                   5557:                 foreach my $id (keys(%{$ipaccessref})) {
                   5558:                     if (ref($ipaccessref->{$id}) eq 'HASH') {
                   5559:                         my $range = $ipaccessref->{$id}->{'ip'};
                   5560:                         if ($range) {
                   5561:                             if (&Apache::lonnet::ip_match($clientip,$range)) {
                   5562:                                 if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
                   5563:                                     if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
                   5564:                                         return ('','','',$id,$dom);
                   5565:                                         last;
                   5566:                                     }
                   5567:                                 }
                   5568:                             }
                   5569:                         }
                   5570:                     }
                   5571:                 }
                   5572:             }
                   5573:         }
1.1373    raeburn  5574:         if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
                   5575:             return ();
                   5576:         }
1.1372    raeburn  5577:     }
1.1189    raeburn  5578:     if (defined($udom) && defined($uname)) {
                   5579:         # If uname and udom are for a course, check for blocks in the course.
                   5580:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   5581:             my ($startblock,$endblock,$triggerblock) =
1.1347    raeburn  5582:                 &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1189    raeburn  5583:             return ($startblock,$endblock,$triggerblock);
                   5584:         }
                   5585:     } else {
1.490     raeburn  5586:         $udom = $env{'user.domain'};
                   5587:         $uname = $env{'user.name'};
                   5588:     }
                   5589: 
1.502     raeburn  5590:     my $startblock = 0;
                   5591:     my $endblock = 0;
1.1062    raeburn  5592:     my $triggerblock = '';
1.1373    raeburn  5593:     my %live_courses;
                   5594:     unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
                   5595:         %live_courses = &findallcourses(undef,$uname,$udom);
                   5596:     }
1.474     raeburn  5597: 
1.490     raeburn  5598:     # If uname is for a user, and activity is course-specific, i.e.,
                   5599:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  5600: 
1.490     raeburn  5601:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282    raeburn  5602:          $activity eq 'groups' || $activity eq 'printout' ||
1.1346    raeburn  5603:          $activity eq 'search' || $activity eq 'reinit' ||
                   5604:          $activity eq 'alert') &&
1.1189    raeburn  5605:         ($env{'request.course.id'})) {
1.490     raeburn  5606:         foreach my $key (keys(%live_courses)) {
                   5607:             if ($key ne $env{'request.course.id'}) {
                   5608:                 delete($live_courses{$key});
                   5609:             }
                   5610:         }
                   5611:     }
                   5612: 
                   5613:     my $otheruser = 0;
                   5614:     my %own_courses;
                   5615:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   5616:         # Resource belongs to user other than current user.
                   5617:         $otheruser = 1;
                   5618:         # Gather courses for current user
                   5619:         %own_courses = 
                   5620:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   5621:     }
                   5622: 
                   5623:     # Gather active course roles - course coordinator, instructor, 
                   5624:     # exam proctor, ta, student, or custom role.
1.474     raeburn  5625: 
                   5626:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  5627:         my ($cdom,$cnum);
                   5628:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   5629:             $cdom = $env{'course.'.$course.'.domain'};
                   5630:             $cnum = $env{'course.'.$course.'.num'};
                   5631:         } else {
1.490     raeburn  5632:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  5633:         }
                   5634:         my $no_ownblock = 0;
                   5635:         my $no_userblock = 0;
1.533     raeburn  5636:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  5637:             # Check if current user has 'evb' priv for this
                   5638:             if (defined($own_courses{$course})) {
                   5639:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   5640:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   5641:                     if ($sec ne 'none') {
                   5642:                         $checkrole .= '/'.$sec;
                   5643:                     }
                   5644:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5645:                         $no_ownblock = 1;
                   5646:                         last;
                   5647:                     }
                   5648:                 }
                   5649:             }
                   5650:             # if they have 'evb' priv and are currently not playing student
                   5651:             next if (($no_ownblock) &&
                   5652:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   5653:         }
1.474     raeburn  5654:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  5655:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  5656:             if ($sec ne 'none') {
1.482     raeburn  5657:                 $checkrole .= '/'.$sec;
1.474     raeburn  5658:             }
1.490     raeburn  5659:             if ($otheruser) {
                   5660:                 # Resource belongs to user other than current user.
                   5661:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  5662:                 my (%allroles,%userroles);
                   5663:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   5664:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   5665:                         my ($trole,$tdom,$tnum,$tsec);
                   5666:                         if ($entry =~ /^cr/) {
                   5667:                             ($trole,$tdom,$tnum,$tsec) = 
                   5668:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   5669:                         } else {
                   5670:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   5671:                         }
                   5672:                         my ($spec,$area,$trest);
                   5673:                         $area = '/'.$tdom.'/'.$tnum;
                   5674:                         $trest = $tnum;
                   5675:                         if ($tsec ne '') {
                   5676:                             $area .= '/'.$tsec;
                   5677:                             $trest .= '/'.$tsec;
                   5678:                         }
                   5679:                         $spec = $trole.'.'.$area;
                   5680:                         if ($trole =~ /^cr/) {
                   5681:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   5682:                                                               $tdom,$spec,$trest,$area);
                   5683:                         } else {
                   5684:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   5685:                                                                 $tdom,$spec,$trest,$area);
                   5686:                         }
                   5687:                     }
1.1276    raeburn  5688:                     my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058    raeburn  5689:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   5690:                         if ($1) {
                   5691:                             $no_userblock = 1;
                   5692:                             last;
                   5693:                         }
1.486     raeburn  5694:                     }
                   5695:                 }
1.490     raeburn  5696:             } else {
                   5697:                 # Resource belongs to current user
                   5698:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  5699:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5700:                     $no_ownblock = 1;
                   5701:                     last;
                   5702:                 }
1.474     raeburn  5703:             }
                   5704:         }
                   5705:         # if they have the evb priv and are currently not playing student
1.482     raeburn  5706:         next if (($no_ownblock) &&
1.491     albertel 5707:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  5708:         next if ($no_userblock);
1.474     raeburn  5709: 
1.1303    raeburn  5710:         # Retrieve blocking times and identity of blocker for course
1.490     raeburn  5711:         # of specified user, unless user has 'evb' privilege.
1.1284    raeburn  5712: 
1.1062    raeburn  5713:         my ($start,$end,$trigger) = 
1.1347    raeburn  5714:             &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502     raeburn  5715:         if (($start != 0) && 
                   5716:             (($startblock == 0) || ($startblock > $start))) {
                   5717:             $startblock = $start;
1.1062    raeburn  5718:             if ($trigger ne '') {
                   5719:                 $triggerblock = $trigger;
                   5720:             }
1.502     raeburn  5721:         }
                   5722:         if (($end != 0)  &&
                   5723:             (($endblock == 0) || ($endblock < $end))) {
                   5724:             $endblock = $end;
1.1062    raeburn  5725:             if ($trigger ne '') {
                   5726:                 $triggerblock = $trigger;
                   5727:             }
1.502     raeburn  5728:         }
1.490     raeburn  5729:     }
1.1062    raeburn  5730:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  5731: }
                   5732: 
                   5733: sub get_blocks {
1.1347    raeburn  5734:     my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490     raeburn  5735:     my $startblock = 0;
                   5736:     my $endblock = 0;
1.1062    raeburn  5737:     my $triggerblock = '';
1.490     raeburn  5738:     my $course = $cdom.'_'.$cnum;
                   5739:     $setters->{$course} = {};
                   5740:     $setters->{$course}{'staff'} = [];
                   5741:     $setters->{$course}{'times'} = [];
1.1062    raeburn  5742:     $setters->{$course}{'triggers'} = [];
                   5743:     my (@blockers,%triggered);
                   5744:     my $now = time;
                   5745:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   5746:     if ($activity eq 'docs') {
1.1348    raeburn  5747:         my ($blocked,$nosymbcache,$noenccheck);
1.1347    raeburn  5748:         if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
                   5749:             $blocked = 1;
                   5750:             $nosymbcache = 1;
1.1348    raeburn  5751:             $noenccheck = 1;
1.1347    raeburn  5752:         }
1.1348    raeburn  5753:         @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062    raeburn  5754:         foreach my $block (@blockers) {
                   5755:             if ($block =~ /^firstaccess____(.+)$/) {
                   5756:                 my $item = $1;
                   5757:                 my $type = 'map';
                   5758:                 my $timersymb = $item;
                   5759:                 if ($item eq 'course') {
                   5760:                     $type = 'course';
                   5761:                 } elsif ($item =~ /___\d+___/) {
                   5762:                     $type = 'resource';
                   5763:                 } else {
                   5764:                     $timersymb = &Apache::lonnet::symbread($item);
                   5765:                 }
                   5766:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5767:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   5768:                 $triggered{$block} = {
                   5769:                                        start => $start,
                   5770:                                        end   => $end,
                   5771:                                        type  => $type,
                   5772:                                      };
                   5773:             }
                   5774:         }
                   5775:     } else {
                   5776:         foreach my $block (keys(%commblocks)) {
                   5777:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   5778:                 my ($start,$end) = ($1,$2);
                   5779:                 if ($start <= time && $end >= time) {
                   5780:                     if (ref($commblocks{$block}) eq 'HASH') {
                   5781:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5782:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5783:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   5784:                                     push(@blockers,$block);
                   5785:                                 }
                   5786:                             }
                   5787:                         }
                   5788:                     }
                   5789:                 }
                   5790:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   5791:                 my $item = $1;
                   5792:                 my $timersymb = $item; 
                   5793:                 my $type = 'map';
                   5794:                 if ($item eq 'course') {
                   5795:                     $type = 'course';
                   5796:                 } elsif ($item =~ /___\d+___/) {
                   5797:                     $type = 'resource';
                   5798:                 } else {
                   5799:                     $timersymb = &Apache::lonnet::symbread($item);
                   5800:                 }
                   5801:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5802:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   5803:                 if ($start && $end) {
                   5804:                     if (($start <= time) && ($end >= time)) {
1.1281    raeburn  5805:                         if (ref($commblocks{$block}) eq 'HASH') {
                   5806:                             if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5807:                                 if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5808:                                     unless(grep(/^\Q$block\E$/,@blockers)) {
                   5809:                                         push(@blockers,$block);
                   5810:                                         $triggered{$block} = {
                   5811:                                                                start => $start,
                   5812:                                                                end   => $end,
                   5813:                                                                type  => $type,
                   5814:                                                              };
                   5815:                                     }
                   5816:                                 }
                   5817:                             }
1.1062    raeburn  5818:                         }
                   5819:                     }
1.490     raeburn  5820:                 }
1.1062    raeburn  5821:             }
                   5822:         }
                   5823:     }
                   5824:     foreach my $blocker (@blockers) {
                   5825:         my ($staff_name,$staff_dom,$title,$blocks) =
                   5826:             &parse_block_record($commblocks{$blocker});
                   5827:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   5828:         my ($start,$end,$triggertype);
                   5829:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   5830:             ($start,$end) = ($1,$2);
                   5831:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   5832:             $start = $triggered{$blocker}{'start'};
                   5833:             $end = $triggered{$blocker}{'end'};
                   5834:             $triggertype = $triggered{$blocker}{'type'};
                   5835:         }
                   5836:         if ($start) {
                   5837:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   5838:             if ($triggertype) {
                   5839:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   5840:             } else {
                   5841:                 push(@{$$setters{$course}{'triggers'}},0);
                   5842:             }
                   5843:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   5844:                 $startblock = $start;
                   5845:                 if ($triggertype) {
                   5846:                     $triggerblock = $blocker;
1.474     raeburn  5847:                 }
                   5848:             }
1.1062    raeburn  5849:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   5850:                $endblock = $end;
                   5851:                if ($triggertype) {
                   5852:                    $triggerblock = $blocker;
                   5853:                }
                   5854:             }
1.474     raeburn  5855:         }
                   5856:     }
1.1062    raeburn  5857:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  5858: }
                   5859: 
                   5860: sub parse_block_record {
                   5861:     my ($record) = @_;
                   5862:     my ($setuname,$setudom,$title,$blocks);
                   5863:     if (ref($record) eq 'HASH') {
                   5864:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   5865:         $title = &unescape($record->{'event'});
                   5866:         $blocks = $record->{'blocks'};
                   5867:     } else {
                   5868:         my @data = split(/:/,$record,3);
                   5869:         if (scalar(@data) eq 2) {
                   5870:             $title = $data[1];
                   5871:             ($setuname,$setudom) = split(/@/,$data[0]);
                   5872:         } else {
                   5873:             ($setuname,$setudom,$title) = @data;
                   5874:         }
                   5875:         $blocks = { 'com' => 'on' };
                   5876:     }
                   5877:     return ($setuname,$setudom,$title,$blocks);
                   5878: }
                   5879: 
1.854     kalberla 5880: sub blocking_status {
1.1372    raeburn  5881:     my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061    raeburn  5882:     my %setters;
1.890     droeschl 5883: 
1.1061    raeburn  5884: # check for active blocking
1.1372    raeburn  5885:     if ($clientip eq '') {
                   5886:         $clientip = &Apache::lonnet::get_requestor_ip();
                   5887:     }
                   5888:     my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
                   5889:         &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062    raeburn  5890:     my $blocked = 0;
1.1372    raeburn  5891:     if (($startblock && $endblock) || ($by_ip)) {
1.1062    raeburn  5892:         $blocked = 1;
                   5893:     }
1.890     droeschl 5894: 
1.1061    raeburn  5895: # caller just wants to know whether a block is active
                   5896:     if (!wantarray) { return $blocked; }
                   5897: 
                   5898: # build a link to a popup window containing the details
                   5899:     my $querystring  = "?activity=$activity";
1.1351    raeburn  5900: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
                   5901:     if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1232    raeburn  5902:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
                   5903:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  5904:     } elsif ($activity eq 'docs') {
1.1347    raeburn  5905:         my $showurl = &Apache::lonenc::check_encrypt($url);
                   5906:         $querystring .= '&amp;url='.&HTML::Entities::encode($showurl,'\'&"<>');
                   5907:         if ($symb) {
                   5908:             my $showsymb = &Apache::lonenc::check_encrypt($symb);
                   5909:             $querystring .= '&amp;symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
                   5910:         }
1.1062    raeburn  5911:     }
1.1061    raeburn  5912: 
                   5913:     my $output .= <<'END_MYBLOCK';
                   5914: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   5915:     var options = "width=" + w + ",height=" + h + ",";
                   5916:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   5917:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   5918:     var newWin = window.open(url, wdwName, options);
                   5919:     newWin.focus();
                   5920: }
1.890     droeschl 5921: END_MYBLOCK
1.854     kalberla 5922: 
1.1061    raeburn  5923:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 5924:   
1.1061    raeburn  5925:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  5926:     my $text = &mt('Communication Blocked');
1.1217    raeburn  5927:     my $class = 'LC_comblock';
1.1062    raeburn  5928:     if ($activity eq 'docs') {
                   5929:         $text = &mt('Content Access Blocked');
1.1217    raeburn  5930:         $class = '';
1.1063    raeburn  5931:     } elsif ($activity eq 'printout') {
                   5932:         $text = &mt('Printing Blocked');
1.1232    raeburn  5933:     } elsif ($activity eq 'passwd') {
                   5934:         $text = &mt('Password Changing Blocked');
1.1345    raeburn  5935:     } elsif ($activity eq 'grades') {
                   5936:         $text = &mt('Gradebook Blocked');
1.1346    raeburn  5937:     } elsif ($activity eq 'search') {
                   5938:         $text = &mt('Search Blocked');
1.1282    raeburn  5939:     } elsif ($activity eq 'alert') {
                   5940:         $text = &mt('Checking Critical Messages Blocked');
                   5941:     } elsif ($activity eq 'reinit') {
                   5942:         $text = &mt('Checking Course Update Blocked');
1.1351    raeburn  5943:     } elsif ($activity eq 'about') {
                   5944:         $text = &mt('Access to User Information Pages Blocked');
1.1373    raeburn  5945:     } elsif ($activity eq 'wishlist') {
                   5946:         $text = &mt('Access to Stored Links Blocked');
                   5947:     } elsif ($activity eq 'annotate') {
                   5948:         $text = &mt('Access to Annotations Blocked');
1.1062    raeburn  5949:     }
1.1061    raeburn  5950:     $output .= <<"END_BLOCK";
1.1217    raeburn  5951: <div class='$class'>
1.869     kalberla 5952:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5953:   title='$text'>
                   5954:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5955:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5956:   title='$text'>$text</a>
1.867     kalberla 5957: </div>
                   5958: 
                   5959: END_BLOCK
1.474     raeburn  5960: 
1.1061    raeburn  5961:     return ($blocked, $output);
1.854     kalberla 5962: }
1.490     raeburn  5963: 
1.60      matthew  5964: ###############################################
                   5965: 
1.682     raeburn  5966: sub check_ip_acc {
1.1201    raeburn  5967:     my ($acc,$clientip)=@_;
1.682     raeburn  5968:     &Apache::lonxml::debug("acc is $acc");
                   5969:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5970:         return 1;
                   5971:     }
1.1339    raeburn  5972:     my ($ip,$allowed);
                   5973:     if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
                   5974:         ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
                   5975:         $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
                   5976:     } else {
1.1350    raeburn  5977:         my $remote_ip = &Apache::lonnet::get_requestor_ip();
                   5978:         $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1339    raeburn  5979:     }
1.682     raeburn  5980: 
                   5981:     my $name;
1.1219    raeburn  5982:     my %access = (
                   5983:                      allowfrom => 1,
                   5984:                      denyfrom  => 0,
                   5985:                  );
                   5986:     my @allows;
                   5987:     my @denies;
                   5988:     foreach my $item (split(',',$acc)) {
                   5989:         $item =~ s/^\s*//;
                   5990:         $item =~ s/\s*$//;
                   5991:         my $pattern;
                   5992:         if ($item =~ /^\!(.+)$/) {
                   5993:             push(@denies,$1);
                   5994:         } else {
                   5995:             push(@allows,$item);
                   5996:         }
                   5997:    }
                   5998:    my $numdenies = scalar(@denies);
                   5999:    my $numallows = scalar(@allows);
                   6000:    my $count = 0;
                   6001:    foreach my $pattern (@denies,@allows) {
                   6002:         $count ++; 
                   6003:         my $acctype = 'allowfrom';
                   6004:         if ($count <= $numdenies) {
                   6005:             $acctype = 'denyfrom';
                   6006:         }
1.682     raeburn  6007:         if ($pattern =~ /\*$/) {
                   6008:             #35.8.*
                   6009:             $pattern=~s/\*//;
1.1219    raeburn  6010:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  6011:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   6012:             #35.8.3.[34-56]
                   6013:             my $low=$2;
                   6014:             my $high=$3;
                   6015:             $pattern=$1;
                   6016:             if ($ip =~ /^\Q$pattern\E/) {
                   6017:                 my $last=(split(/\./,$ip))[3];
1.1219    raeburn  6018:                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  6019:             }
                   6020:         } elsif ($pattern =~ /^\*/) {
                   6021:             #*.msu.edu
                   6022:             $pattern=~s/\*//;
                   6023:             if (!defined($name)) {
                   6024:                 use Socket;
                   6025:                 my $netaddr=inet_aton($ip);
                   6026:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   6027:             }
1.1219    raeburn  6028:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  6029:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   6030:             #127.0.0.1
1.1219    raeburn  6031:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  6032:         } else {
                   6033:             #some.name.com
                   6034:             if (!defined($name)) {
                   6035:                 use Socket;
                   6036:                 my $netaddr=inet_aton($ip);
                   6037:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   6038:             }
1.1219    raeburn  6039:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   6040:         }
                   6041:         if ($allowed =~ /^(0|1)$/) { last; }
                   6042:     }
                   6043:     if ($allowed eq '') {
                   6044:         if ($numdenies && !$numallows) {
                   6045:             $allowed = 1;
                   6046:         } else {
                   6047:             $allowed = 0;
1.682     raeburn  6048:         }
                   6049:     }
                   6050:     return $allowed;
                   6051: }
                   6052: 
                   6053: ###############################################
                   6054: 
1.60      matthew  6055: =pod
                   6056: 
1.112     bowersj2 6057: =head1 Domain Template Functions
                   6058: 
                   6059: =over 4
                   6060: 
                   6061: =item * &determinedomain()
1.60      matthew  6062: 
                   6063: Inputs: $domain (usually will be undef)
                   6064: 
1.63      www      6065: Returns: Determines which domain should be used for designs
1.60      matthew  6066: 
                   6067: =cut
1.54      www      6068: 
1.60      matthew  6069: ###############################################
1.63      www      6070: sub determinedomain {
                   6071:     my $domain=shift;
1.531     albertel 6072:     if (! $domain) {
1.60      matthew  6073:         # Determine domain if we have not been given one
1.893     raeburn  6074:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 6075:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   6076:         if ($env{'request.role.domain'}) { 
                   6077:             $domain=$env{'request.role.domain'}; 
1.60      matthew  6078:         }
                   6079:     }
1.63      www      6080:     return $domain;
                   6081: }
                   6082: ###############################################
1.517     raeburn  6083: 
1.518     albertel 6084: sub devalidate_domconfig_cache {
                   6085:     my ($udom)=@_;
                   6086:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   6087: }
                   6088: 
                   6089: # ---------------------- Get domain configuration for a domain
                   6090: sub get_domainconf {
                   6091:     my ($udom) = @_;
                   6092:     my $cachetime=1800;
                   6093:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   6094:     if (defined($cached)) { return %{$result}; }
                   6095: 
                   6096:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  6097: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  6098:     my (%designhash,%legacy);
1.518     albertel 6099:     if (keys(%domconfig) > 0) {
                   6100:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  6101:             if (keys(%{$domconfig{'login'}})) {
                   6102:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  6103:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208    raeburn  6104:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   6105:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   6106:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   6107:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   6108:                                         if ($key eq 'loginvia') {
                   6109:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   6110:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   6111:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   6112:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   6113: 
                   6114:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   6115:                                                 } else {
                   6116:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   6117:                                                 }
1.948     raeburn  6118:                                             }
1.1208    raeburn  6119:                                         } elsif ($key eq 'headtag') {
                   6120:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   6121:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  6122:                                             }
1.946     raeburn  6123:                                         }
1.1208    raeburn  6124:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   6125:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   6126:                                         }
1.946     raeburn  6127:                                     }
                   6128:                                 }
                   6129:                             }
1.1366    raeburn  6130:                         } elsif ($key eq 'saml') {
                   6131:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   6132:                                 foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
                   6133:                                     if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
                   6134:                                         $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1386    raeburn  6135:                                         foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1366    raeburn  6136:                                             $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
                   6137:                                         }
                   6138:                                     }
                   6139:                                 }
                   6140:                             }
1.946     raeburn  6141:                         } else {
                   6142:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   6143:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   6144:                                     $domconfig{'login'}{$key}{$img};
                   6145:                             }
1.699     raeburn  6146:                         }
                   6147:                     } else {
                   6148:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   6149:                     }
1.632     raeburn  6150:                 }
                   6151:             } else {
                   6152:                 $legacy{'login'} = 1;
1.518     albertel 6153:             }
1.632     raeburn  6154:         } else {
                   6155:             $legacy{'login'} = 1;
1.518     albertel 6156:         }
                   6157:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  6158:             if (keys(%{$domconfig{'rolecolors'}})) {
                   6159:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   6160:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   6161:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   6162:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   6163:                         }
1.518     albertel 6164:                     }
                   6165:                 }
1.632     raeburn  6166:             } else {
                   6167:                 $legacy{'rolecolors'} = 1;
1.518     albertel 6168:             }
1.632     raeburn  6169:         } else {
                   6170:             $legacy{'rolecolors'} = 1;
1.518     albertel 6171:         }
1.948     raeburn  6172:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   6173:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   6174:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   6175:             }
                   6176:         }
1.632     raeburn  6177:         if (keys(%legacy) > 0) {
                   6178:             my %legacyhash = &get_legacy_domconf($udom);
                   6179:             foreach my $item (keys(%legacyhash)) {
                   6180:                 if ($item =~ /^\Q$udom\E\.login/) {
                   6181:                     if ($legacy{'login'}) { 
                   6182:                         $designhash{$item} = $legacyhash{$item};
                   6183:                     }
                   6184:                 } else {
                   6185:                     if ($legacy{'rolecolors'}) {
                   6186:                         $designhash{$item} = $legacyhash{$item};
                   6187:                     }
1.518     albertel 6188:                 }
                   6189:             }
                   6190:         }
1.632     raeburn  6191:     } else {
                   6192:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 6193:     }
                   6194:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   6195: 				  $cachetime);
                   6196:     return %designhash;
                   6197: }
                   6198: 
1.632     raeburn  6199: sub get_legacy_domconf {
                   6200:     my ($udom) = @_;
                   6201:     my %legacyhash;
                   6202:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   6203:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   6204:     if (-e $designfile) {
1.1317    raeburn  6205:         if ( open (my $fh,'<',$designfile) ) {
1.632     raeburn  6206:             while (my $line = <$fh>) {
                   6207:                 next if ($line =~ /^\#/);
                   6208:                 chomp($line);
                   6209:                 my ($key,$val)=(split(/\=/,$line));
                   6210:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   6211:             }
                   6212:             close($fh);
                   6213:         }
                   6214:     }
1.1026    raeburn  6215:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  6216:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   6217:     }
                   6218:     return %legacyhash;
                   6219: }
                   6220: 
1.63      www      6221: =pod
                   6222: 
1.112     bowersj2 6223: =item * &domainlogo()
1.63      www      6224: 
                   6225: Inputs: $domain (usually will be undef)
                   6226: 
                   6227: Returns: A link to a domain logo, if the domain logo exists.
                   6228: If the domain logo does not exist, a description of the domain.
                   6229: 
                   6230: =cut
1.112     bowersj2 6231: 
1.63      www      6232: ###############################################
                   6233: sub domainlogo {
1.517     raeburn  6234:     my $domain = &determinedomain(shift);
1.518     albertel 6235:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  6236:     # See if there is a logo
                   6237:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  6238:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 6239:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   6240: 	    if ($imgsrc =~ m{^/res/}) {
                   6241: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   6242: 		&Apache::lonnet::repcopy($local_name);
                   6243: 	    }
                   6244: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.1374    raeburn  6245:         }
                   6246:         my $alttext = $domain;
                   6247:         if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
                   6248:             $alttext = $designhash{$domain.'.login.alttext_domlogo'};
                   6249:         }
                   6250:         return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514     albertel 6251:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   6252:         return &Apache::lonnet::domain($domain,'description');
1.59      www      6253:     } else {
1.60      matthew  6254:         return '';
1.59      www      6255:     }
                   6256: }
1.63      www      6257: ##############################################
                   6258: 
                   6259: =pod
                   6260: 
1.112     bowersj2 6261: =item * &designparm()
1.63      www      6262: 
                   6263: Inputs: $which parameter; $domain (usually will be undef)
                   6264: 
                   6265: Returns: value of designparamter $which
                   6266: 
                   6267: =cut
1.112     bowersj2 6268: 
1.397     albertel 6269: 
1.400     albertel 6270: ##############################################
1.397     albertel 6271: sub designparm {
                   6272:     my ($which,$domain)=@_;
                   6273:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   6274:         return $env{'environment.color.'.$which};
1.96      www      6275:     }
1.63      www      6276:     $domain=&determinedomain($domain);
1.1016    raeburn  6277:     my %domdesign;
                   6278:     unless ($domain eq 'public') {
                   6279:         %domdesign = &get_domainconf($domain);
                   6280:     }
1.520     raeburn  6281:     my $output;
1.517     raeburn  6282:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   6283:         $output = $domdesign{$domain.'.'.$which};
1.63      www      6284:     } else {
1.520     raeburn  6285:         $output = $defaultdesign{$which};
                   6286:     }
                   6287:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  6288:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 6289:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   6290:             if ($output =~ m{^/res/}) {
                   6291:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   6292:                 &Apache::lonnet::repcopy($local_name);
                   6293:             }
1.520     raeburn  6294:             $output = &lonhttpdurl($output);
                   6295:         }
1.63      www      6296:     }
1.520     raeburn  6297:     return $output;
1.63      www      6298: }
1.59      www      6299: 
1.822     bisitz   6300: ##############################################
                   6301: =pod
                   6302: 
1.832     bisitz   6303: =item * &authorspace()
                   6304: 
1.1028    raeburn  6305: Inputs: $url (usually will be undef).
1.832     bisitz   6306: 
1.1132    raeburn  6307: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  6308:          directory being viewed (or for which action is being taken). 
                   6309:          If $url is provided, and begins /priv/<domain>/<uname>
                   6310:          the path will be that portion of the $context argument.
                   6311:          Otherwise the path will be for the author space of the current
                   6312:          user when the current role is author, or for that of the 
                   6313:          co-author/assistant co-author space when the current role 
                   6314:          is co-author or assistant co-author.
1.832     bisitz   6315: 
                   6316: =cut
                   6317: 
                   6318: sub authorspace {
1.1028    raeburn  6319:     my ($url) = @_;
                   6320:     if ($url ne '') {
                   6321:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   6322:            return $1;
                   6323:         }
                   6324:     }
1.832     bisitz   6325:     my $caname = '';
1.1024    www      6326:     my $cadom = '';
1.1028    raeburn  6327:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      6328:         ($cadom,$caname) =
1.832     bisitz   6329:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  6330:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   6331:         $caname = $env{'user.name'};
1.1024    www      6332:         $cadom = $env{'user.domain'};
1.832     bisitz   6333:     }
1.1028    raeburn  6334:     if (($caname ne '') && ($cadom ne '')) {
                   6335:         return "/priv/$cadom/$caname/";
                   6336:     }
                   6337:     return;
1.832     bisitz   6338: }
                   6339: 
                   6340: ##############################################
                   6341: =pod
                   6342: 
1.822     bisitz   6343: =item * &head_subbox()
                   6344: 
                   6345: Inputs: $content (contains HTML code with page functions, etc.)
                   6346: 
                   6347: Returns: HTML div with $content
                   6348:          To be included in page header
                   6349: 
                   6350: =cut
                   6351: 
                   6352: sub head_subbox {
                   6353:     my ($content)=@_;
                   6354:     my $output =
1.993     raeburn  6355:         '<div class="LC_head_subbox">'
1.822     bisitz   6356:        .$content
                   6357:        .'</div>'
                   6358: }
                   6359: 
                   6360: ##############################################
                   6361: =pod
                   6362: 
                   6363: =item * &CSTR_pageheader()
                   6364: 
1.1026    raeburn  6365: Input: (optional) filename from which breadcrumb trail is built.
                   6366:        In most cases no input as needed, as $env{'request.filename'}
                   6367:        is appropriate for use in building the breadcrumb trail.
1.1379    raeburn  6368:        frameset flag
                   6369:        If page header is being requested for use in a frameset, then
                   6370:        the second (option) argument -- frameset will be true, and
                   6371:        the target attribute set for links should be target="_parent".
1.822     bisitz   6372: 
                   6373: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  6374:          To be included on Authoring Space pages
1.822     bisitz   6375: 
                   6376: =cut
                   6377: 
                   6378: sub CSTR_pageheader {
1.1379    raeburn  6379:     my ($trailfile,$frameset) = @_;
1.1026    raeburn  6380:     if ($trailfile eq '') {
                   6381:         $trailfile = $env{'request.filename'};
                   6382:     }
                   6383: 
                   6384: # this is for resources; directories have customtitle, and crumbs
                   6385: # and select recent are created in lonpubdir.pm
                   6386: 
                   6387:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      6388:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  6389:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  6390:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   6391:     $formaction =~ s{/+}{/}g;
1.822     bisitz   6392: 
                   6393:     my $parentpath = '';
                   6394:     my $lastitem = '';
                   6395:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   6396:         $parentpath = $1;
                   6397:         $lastitem = $2;
                   6398:     } else {
                   6399:         $lastitem = $thisdisfn;
                   6400:     }
1.921     bisitz   6401: 
1.1246    raeburn  6402:     my ($crsauthor,$title);
                   6403:     if (($env{'request.course.id'}) &&
                   6404:         ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247    raeburn  6405:         ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246    raeburn  6406:         $crsauthor = 1;
                   6407:         $title = &mt('Course Authoring Space');
                   6408:     } else {
                   6409:         $title = &mt('Authoring Space');
                   6410:     }
                   6411: 
1.1379    raeburn  6412:     my ($target,$crumbtarget) = (' target="_top"','_top');
                   6413:     if ($frameset) {
                   6414:         $target = ' target="_parent"';
                   6415:         $crumbtarget = '_parent';
                   6416:     } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314    raeburn  6417:         $target = '';
                   6418:         $crumbtarget = '';
1.1379    raeburn  6419:     } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
1.1378    raeburn  6420:         $target = ' target="'.$env{'request.deeplink.target'}.'"';
                   6421:         $crumbtarget = $env{'request.deeplink.target'};
                   6422:     }
1.1313    raeburn  6423: 
1.921     bisitz   6424:     my $output =
1.822     bisitz   6425:          '<div>'
                   6426:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246    raeburn  6427:         .'<b>'.$title.'</b> '
1.1314    raeburn  6428:         .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
                   6429:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921     bisitz   6430: 
                   6431:     if ($lastitem) {
                   6432:         $output .=
                   6433:              '<span class="LC_filename">'
                   6434:             .$lastitem
                   6435:             .'</span>';
                   6436:     }
1.1245    raeburn  6437: 
1.1246    raeburn  6438:     if ($crsauthor) {
1.1379    raeburn  6439:         $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
1.1246    raeburn  6440:     } else {
                   6441:         $output .=
                   6442:              '<br />'
1.1314    raeburn  6443:             #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246    raeburn  6444:             .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   6445:             .'</form>'
1.1379    raeburn  6446:             .&Apache::lonmenu::constspaceform($frameset);
1.1246    raeburn  6447:     }
                   6448:     $output .= '</div>';
1.921     bisitz   6449: 
                   6450:     return $output;
1.822     bisitz   6451: }
                   6452: 
1.60      matthew  6453: ###############################################
                   6454: ###############################################
                   6455: 
                   6456: =pod
                   6457: 
1.112     bowersj2 6458: =back
                   6459: 
1.549     albertel 6460: =head1 HTML Helpers
1.112     bowersj2 6461: 
                   6462: =over 4
                   6463: 
                   6464: =item * &bodytag()
1.60      matthew  6465: 
                   6466: Returns a uniform header for LON-CAPA web pages.
                   6467: 
                   6468: Inputs: 
                   6469: 
1.112     bowersj2 6470: =over 4
                   6471: 
                   6472: =item * $title, A title to be displayed on the page.
                   6473: 
                   6474: =item * $function, the current role (can be undef).
                   6475: 
                   6476: =item * $addentries, extra parameters for the <body> tag.
                   6477: 
                   6478: =item * $bodyonly, if defined, only return the <body> tag.
                   6479: 
                   6480: =item * $domain, if defined, force a given domain.
                   6481: 
                   6482: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      6483:             text interface only)
1.60      matthew  6484: 
1.814     bisitz   6485: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   6486:                      navigational links
1.317     albertel 6487: 
1.338     albertel 6488: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   6489: 
1.460     albertel 6490: =item * $args, optional argument valid values are
                   6491:             no_auto_mt_title -> prevents &mt()ing the title arg
1.1274    raeburn  6492:             use_absolute     -> for external resource or syllabus, this will
                   6493:                                 contain https://<hostname> if server uses
                   6494:                                 https (as per hosts.tab), but request is for http
                   6495:             hostname         -> hostname, from $r->hostname().
1.460     albertel 6496: 
1.1096    raeburn  6497: =item * $advtoolsref, optional argument, ref to an array containing
                   6498:             inlineremote items to be added in "Functions" menu below
                   6499:             breadcrumbs.
                   6500: 
1.1316    raeburn  6501: =item * $ltiscope, optional argument, will be one of: resource, map or
                   6502:             course, if LON-CAPA is in LTI Provider context. Value is
                   6503:             the scope of use, i.e., launch was for access to a single, a map
                   6504:             or the entire course.
                   6505: 
                   6506: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
                   6507:             context, this will contain the URL for the landing item in
                   6508:             the course, after launch from an LTI Consumer
                   6509: 
1.1318    raeburn  6510: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
                   6511:             context, this will contain a reference to hash of items
                   6512:             to be included in the page header and/or inline menu.
                   6513: 
1.1385    raeburn  6514: =item * $menucoll, optional argument, if specific menu collection is in
                   6515:             effect, either set as the default for the course, or set for
                   6516:             the deeplink paramater for $env{'request.deeplink.login'}
                   6517:             then $menucoll will be the number of that collection. 
                   6518: 
                   6519: =item * $menuref, optional argument, reference to a hash, containing the
                   6520:             menu options included for the menu in effect, based on the
                   6521:             configuration for the numbered menu collection in use.  
                   6522: 
                   6523: =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
                   6524:             within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
                   6525:             if so, $showncrumbsref is set there to 1, and will propagate back
                   6526:             via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
                   6527:             being called a second time.
                   6528: 
1.112     bowersj2 6529: =back
                   6530: 
1.60      matthew  6531: Returns: A uniform header for LON-CAPA web pages.  
                   6532: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   6533: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   6534: other decorations will be returned.
                   6535: 
                   6536: =cut
                   6537: 
1.54      www      6538: sub bodytag {
1.831     bisitz   6539:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359    raeburn  6540:         $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
1.1385    raeburn  6541:         $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339     albertel 6542: 
1.954     raeburn  6543:     my $public;
                   6544:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   6545:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   6546:         $public = 1;
                   6547:     }
1.460     albertel 6548:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  6549:     my $httphost = $args->{'use_absolute'};
1.1274    raeburn  6550:     my $hostname = $args->{'hostname'};
1.339     albertel 6551: 
1.183     matthew  6552:     $function = &get_users_function() if (!$function);
1.339     albertel 6553:     my $img =    &designparm($function.'.img',$domain);
                   6554:     my $font =   &designparm($function.'.font',$domain);
                   6555:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   6556: 
1.803     bisitz   6557:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 6558: 		   'bgcolor' => $pgbg,
1.339     albertel 6559: 		   'text'    => $font,
                   6560:                    'alink'   => &designparm($function.'.alink',$domain),
                   6561: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   6562: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 6563:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 6564: 
1.63      www      6565:  # role and realm
1.1178    raeburn  6566:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   6567:     if ($realm) {
                   6568:         $realm = '/'.$realm;
                   6569:     }
1.1357    raeburn  6570:     if ($role eq 'ca') {
1.479     albertel 6571:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 6572:         $realm = &plainname($rname,$rdom);
1.378     raeburn  6573:     } 
1.55      www      6574: # realm
1.1357    raeburn  6575:     my ($cid,$sec);
1.258     albertel 6576:     if ($env{'request.course.id'}) {
1.1357    raeburn  6577:         $cid = $env{'request.course.id'};
                   6578:         if ($env{'request.course.sec'}) {
                   6579:             $sec = $env{'request.course.sec'};
                   6580:         }
                   6581:     } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
                   6582:         if (&Apache::lonnet::is_course($1,$2)) {
                   6583:             $cid = $1.'_'.$2;
                   6584:             $sec = $3;
                   6585:         }
                   6586:     }
                   6587:     if ($cid) {
1.378     raeburn  6588:         if ($env{'request.role'} !~ /^cr/) {
                   6589:             $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257    raeburn  6590:         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269    raeburn  6591:             if ($env{'request.role.desc'}) {
                   6592:                 $role = $env{'request.role.desc'};
                   6593:             } else {
                   6594:                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
                   6595:             }
1.1257    raeburn  6596:         } else {
                   6597:             $role = (split(/\//,$role,4))[-1]; 
1.378     raeburn  6598:         }
1.1357    raeburn  6599:         if ($sec) {
                   6600:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$sec;
1.898     raeburn  6601:         }   
1.1357    raeburn  6602: 	$realm = $env{'course.'.$cid.'.description'};
1.378     raeburn  6603:     } else {
                   6604:         $role = &Apache::lonnet::plaintext($role);
1.54      www      6605:     }
1.433     albertel 6606: 
1.359     albertel 6607:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 6608: 
1.438     albertel 6609:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 6610: 
1.101     www      6611: # construct main body tag
1.359     albertel 6612:     my $bodytag = "<body $extra_body_attr>".
1.1235    raeburn  6613: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 6614: 
1.1131    raeburn  6615:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   6616: 
1.1130    raeburn  6617:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  6618:         return $bodytag;
1.1130    raeburn  6619:     }
1.359     albertel 6620: 
1.954     raeburn  6621:     if ($public) {
1.433     albertel 6622: 	undef($role);
                   6623:     }
1.1318    raeburn  6624: 
1.1359    raeburn  6625:     my $showcrstitle = 1;
1.1357    raeburn  6626:     if (($cid) && ($env{'request.lti.login'})) {
1.1318    raeburn  6627:         if (ref($ltimenu) eq 'HASH') {
                   6628:             unless ($ltimenu->{'role'}) {
                   6629:                 undef($role);
                   6630:             }
                   6631:             unless ($ltimenu->{'coursetitle'}) {
                   6632:                 $realm='&nbsp;';
1.1359    raeburn  6633:                 $showcrstitle = 0;
                   6634:             }
                   6635:         }
                   6636:     } elsif (($cid) && ($menucoll)) {
                   6637:         if (ref($menuref) eq 'HASH') {
                   6638:             unless ($menuref->{'role'}) {
                   6639:                 undef($role);
                   6640:             }
                   6641:             unless ($menuref->{'crs'}) {
                   6642:                 $realm='&nbsp;';
                   6643:                 $showcrstitle = 0;
1.1318    raeburn  6644:             }
                   6645:         }
                   6646:     }
                   6647: 
1.762     bisitz   6648:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 6649:     #
                   6650:     # Extra info if you are the DC
                   6651:     my $dc_info = '';
1.1359    raeburn  6652:     if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357    raeburn  6653:         (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917     raeburn  6654:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      6655:         $dc_info =~ s/\s+$//;
1.359     albertel 6656:     }
                   6657: 
1.1237    raeburn  6658:     my $crstype;
1.1357    raeburn  6659:     if ($cid) {
                   6660:         $crstype = $env{'course.'.$cid.'.type'};
1.1237    raeburn  6661:     } elsif ($args->{'crstype'}) {
                   6662:         $crstype = $args->{'crstype'};
                   6663:     }
                   6664:     if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
                   6665:         undef($role);
                   6666:     } else {
1.1242    raeburn  6667:         $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237    raeburn  6668:     }
1.853     droeschl 6669: 
1.903     droeschl 6670:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   6671: 
                   6672:         #    if ($env{'request.state'} eq 'construct') {
                   6673:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   6674:         #    }
                   6675: 
1.1130    raeburn  6676:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  6677:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 6678: 
1.1318    raeburn  6679:         unless ($args->{'no_primary_menu'}) {
1.1369    raeburn  6680:             my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
1.1380    raeburn  6681:                                                               $args->{'links_disabled'},
                   6682:                                                               $args->{'links_target'});
1.359     albertel 6683: 
1.1318    raeburn  6684:             if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
                   6685:                 if ($dc_info) {
                   6686:                     $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   6687:                 }
                   6688:                 $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
                   6689:                                <em>$realm</em> $dc_info</div>|;
                   6690:                 return $bodytag;
                   6691:             }
1.894     droeschl 6692: 
1.1318    raeburn  6693:             unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   6694:                 $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
                   6695:             }
1.916     droeschl 6696: 
1.1318    raeburn  6697:             $bodytag .= $right;
1.852     droeschl 6698: 
1.1318    raeburn  6699:             if ($dc_info) {
                   6700:                 $dc_info = &dc_courseid_toggle($dc_info);
                   6701:             }
                   6702:             $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917     raeburn  6703:         }
1.916     droeschl 6704: 
1.1169    raeburn  6705:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  6706:         if ($args->{'no_secondary_menu'}) {
                   6707:             return $bodytag;
                   6708:         }
1.1169    raeburn  6709:         #don't show menus for public users
1.954     raeburn  6710:         if (!$public){
1.1318    raeburn  6711:             unless ($args->{'no_inline_menu'}) {
                   6712:                 $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359    raeburn  6713:                                                             $args->{'no_primary_menu'},
1.1369    raeburn  6714:                                                             $menucoll,$menuref,
1.1380    raeburn  6715:                                                             $args->{'links_disabled'},
                   6716:                                                             $args->{'links_target'});
1.1318    raeburn  6717:             }
1.903     droeschl 6718:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  6719:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   6720:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 6721:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1385    raeburn  6722:                                 $args->{'bread_crumbs'},'','',$hostname,
                   6723:                                 $ltiscope,$ltiuri,$showncrumbsref);
1.1096    raeburn  6724:             } elsif ($forcereg) {
                   6725:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1385    raeburn  6726:                                 $args->{'group'},$args->{'hide_buttons'},
                   6727:                                 $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1096    raeburn  6728:             } else {
                   6729:                 $bodytag .= 
                   6730:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   6731:                                                         $forcereg,$args->{'group'},
                   6732:                                                         $args->{'bread_crumbs'},
1.1274    raeburn  6733:                                                         $advtoolsref,'',$hostname);
1.920     raeburn  6734:             }
1.903     droeschl 6735:         }else{
                   6736:             # this is to seperate menu from content when there's no secondary
                   6737:             # menu. Especially needed for public accessible ressources.
                   6738:             $bodytag .= '<hr style="clear:both" />';
                   6739:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  6740:         }
1.903     droeschl 6741: 
1.235     raeburn  6742:         return $bodytag;
1.182     matthew  6743: }
                   6744: 
1.917     raeburn  6745: sub dc_courseid_toggle {
                   6746:     my ($dc_info) = @_;
1.980     raeburn  6747:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  6748:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  6749:            &mt('(More ...)').'</a></span>'.
                   6750:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   6751: }
                   6752: 
1.330     albertel 6753: sub make_attr_string {
                   6754:     my ($register,$attr_ref) = @_;
                   6755: 
                   6756:     if ($attr_ref && !ref($attr_ref)) {
                   6757: 	die("addentries Must be a hash ref ".
                   6758: 	    join(':',caller(1))." ".
                   6759: 	    join(':',caller(0))." ");
                   6760:     }
                   6761: 
                   6762:     if ($register) {
1.339     albertel 6763: 	my ($on_load,$on_unload);
                   6764: 	foreach my $key (keys(%{$attr_ref})) {
                   6765: 	    if      (lc($key) eq 'onload') {
                   6766: 		$on_load.=$attr_ref->{$key}.';';
                   6767: 		delete($attr_ref->{$key});
                   6768: 
                   6769: 	    } elsif (lc($key) eq 'onunload') {
                   6770: 		$on_unload.=$attr_ref->{$key}.';';
                   6771: 		delete($attr_ref->{$key});
                   6772: 	    }
                   6773: 	}
1.953     droeschl 6774: 	$attr_ref->{'onload'}  = $on_load;
                   6775: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 6776:     }
1.339     albertel 6777: 
1.330     albertel 6778:     my $attr_string;
1.1159    raeburn  6779:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 6780: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   6781:     }
                   6782:     return $attr_string;
                   6783: }
                   6784: 
                   6785: 
1.182     matthew  6786: ###############################################
1.251     albertel 6787: ###############################################
                   6788: 
                   6789: =pod
                   6790: 
                   6791: =item * &endbodytag()
                   6792: 
                   6793: Returns a uniform footer for LON-CAPA web pages.
                   6794: 
1.635     raeburn  6795: Inputs: 1 - optional reference to an args hash
                   6796: If in the hash, key for noredirectlink has a value which evaluates to true,
                   6797: a 'Continue' link is not displayed if the page contains an
                   6798: internal redirect in the <head></head> section,
                   6799: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 6800: 
                   6801: =cut
                   6802: 
                   6803: sub endbodytag {
1.635     raeburn  6804:     my ($args) = @_;
1.1080    raeburn  6805:     my $endbodytag;
                   6806:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   6807:         $endbodytag='</body>';
                   6808:     }
1.315     albertel 6809:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  6810:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1386    raeburn  6811:             my ($endbodyjs,$idattr);
                   6812:             if ($env{'internal.head.to_opener'}) {
                   6813:                 my $linkid = 'LC_continue_link';
                   6814:                 $idattr = ' id="'.$linkid.'"';
                   6815:                 my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
                   6816:                 $endbodyjs=<<ENDJS;
                   6817: <script type="text/javascript">
                   6818: // <![CDATA[
                   6819: function ebFunction(evt) {
                   6820:     evt.preventDefault();
                   6821:     var dest = '$redirect_for_js';
                   6822:     if (window.opener != null && !window.opener.closed) {
                   6823:         window.opener.location.href=dest;
                   6824:         window.close();
                   6825:     } else {
                   6826:         window.location.href=dest;
                   6827:     }
                   6828:     return false;
                   6829: }
                   6830: 
                   6831: \$(document).ready(function () {
                   6832:   if (document.getElementById('$linkid')) {
                   6833:     var clickelem = document.getElementById('$linkid');
                   6834:     clickelem.addEventListener('click',ebFunction,false);
                   6835:   }
                   6836: });
                   6837: // ]]>
                   6838: </script>
                   6839: ENDJS
                   6840:             }
1.635     raeburn  6841: 	    $endbodytag=
1.1386    raeburn  6842: 	        "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635     raeburn  6843: 	        &mt('Continue').'</a>'.
                   6844: 	        $endbodytag;
                   6845:         }
1.315     albertel 6846:     }
1.251     albertel 6847:     return $endbodytag;
                   6848: }
                   6849: 
1.352     albertel 6850: =pod
                   6851: 
                   6852: =item * &standard_css()
                   6853: 
                   6854: Returns a style sheet
                   6855: 
                   6856: Inputs: (all optional)
                   6857:             domain         -> force to color decorate a page for a specific
                   6858:                                domain
                   6859:             function       -> force usage of a specific rolish color scheme
                   6860:             bgcolor        -> override the default page bgcolor
                   6861: 
                   6862: =cut
                   6863: 
1.343     albertel 6864: sub standard_css {
1.345     albertel 6865:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 6866:     $function  = &get_users_function() if (!$function);
                   6867:     my $img    = &designparm($function.'.img',   $domain);
                   6868:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   6869:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 6870:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 6871: #second colour for later usage
1.345     albertel 6872:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 6873:     my $pgbg_or_bgcolor =
                   6874: 	         $bgcolor ||
1.352     albertel 6875: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 6876:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 6877:     my $alink  = &designparm($function.'.alink', $domain);
                   6878:     my $vlink  = &designparm($function.'.vlink', $domain);
                   6879:     my $link   = &designparm($function.'.link',  $domain);
                   6880: 
1.602     albertel 6881:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 6882:     my $mono                 = 'monospace';
1.850     bisitz   6883:     my $data_table_head      = $sidebg;
                   6884:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   6885:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 6886:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 6887:     my $data_table_highlight = '#FFFF00';
1.352     albertel 6888:     my $mail_new             = '#FFBB77';
                   6889:     my $mail_new_hover       = '#DD9955';
                   6890:     my $mail_read            = '#BBBB77';
                   6891:     my $mail_read_hover      = '#999944';
                   6892:     my $mail_replied         = '#AAAA88';
                   6893:     my $mail_replied_hover   = '#888855';
                   6894:     my $mail_other           = '#99BBBB';
                   6895:     my $mail_other_hover     = '#669999';
1.391     albertel 6896:     my $table_header         = '#DDDDDD';
1.489     raeburn  6897:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   6898:     my $lg_border_color      = '#C8C8C8';
1.952     onken    6899:     my $button_hover         = '#BF2317';
1.392     albertel 6900: 
1.608     albertel 6901:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   6902:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   6903:                                              : '0 3px 0 4px';
1.448     albertel 6904: 
1.523     albertel 6905: 
1.343     albertel 6906:     return <<END;
1.947     droeschl 6907: 
                   6908: /* needed for iframe to allow 100% height in FF */
                   6909: body, html { 
                   6910:     margin: 0;
                   6911:     padding: 0 0.5%;
                   6912:     height: 99%; /* to avoid scrollbars */
                   6913: }
                   6914: 
1.795     www      6915: body {
1.911     bisitz   6916:   font-family: $sans;
                   6917:   line-height:130%;
                   6918:   font-size:0.83em;
                   6919:   color:$font;
1.795     www      6920: }
                   6921: 
1.959     onken    6922: a:focus,
                   6923: a:focus img {
1.795     www      6924:   color: red;
                   6925: }
1.698     harmsja  6926: 
1.911     bisitz   6927: form, .inline {
                   6928:   display: inline;
1.795     www      6929: }
1.721     harmsja  6930: 
1.795     www      6931: .LC_right {
1.911     bisitz   6932:   text-align:right;
1.795     www      6933: }
                   6934: 
                   6935: .LC_middle {
1.911     bisitz   6936:   vertical-align:middle;
1.795     www      6937: }
1.721     harmsja  6938: 
1.1130    raeburn  6939: .LC_floatleft {
                   6940:   float: left;
                   6941: }
                   6942: 
                   6943: .LC_floatright {
                   6944:   float: right;
                   6945: }
                   6946: 
1.911     bisitz   6947: .LC_400Box {
                   6948:   width:400px;
                   6949: }
1.721     harmsja  6950: 
1.947     droeschl 6951: .LC_iframecontainer {
                   6952:     width: 98%;
                   6953:     margin: 0;
                   6954:     position: fixed;
                   6955:     top: 8.5em;
                   6956:     bottom: 0;
                   6957: }
                   6958: 
                   6959: .LC_iframecontainer iframe{
                   6960:     border: none;
                   6961:     width: 100%;
                   6962:     height: 100%;
                   6963: }
                   6964: 
1.778     bisitz   6965: .LC_filename {
                   6966:   font-family: $mono;
                   6967:   white-space:pre;
1.921     bisitz   6968:   font-size: 120%;
1.778     bisitz   6969: }
                   6970: 
                   6971: .LC_fileicon {
                   6972:   border: none;
                   6973:   height: 1.3em;
                   6974:   vertical-align: text-bottom;
                   6975:   margin-right: 0.3em;
                   6976:   text-decoration:none;
                   6977: }
                   6978: 
1.1008    www      6979: .LC_setting {
                   6980:   text-decoration:underline;
                   6981: }
                   6982: 
1.350     albertel 6983: .LC_error {
                   6984:   color: red;
                   6985: }
1.795     www      6986: 
1.1097    bisitz   6987: .LC_warning {
                   6988:   color: darkorange;
                   6989: }
                   6990: 
1.457     albertel 6991: .LC_diff_removed {
1.733     bisitz   6992:   color: red;
1.394     albertel 6993: }
1.532     albertel 6994: 
                   6995: .LC_info,
1.457     albertel 6996: .LC_success,
                   6997: .LC_diff_added {
1.350     albertel 6998:   color: green;
                   6999: }
1.795     www      7000: 
1.802     bisitz   7001: div.LC_confirm_box {
                   7002:   background-color: #FAFAFA;
                   7003:   border: 1px solid $lg_border_color;
                   7004:   margin-right: 0;
                   7005:   padding: 5px;
                   7006: }
                   7007: 
                   7008: div.LC_confirm_box .LC_error img,
                   7009: div.LC_confirm_box .LC_success img {
                   7010:   vertical-align: middle;
                   7011: }
                   7012: 
1.1242    raeburn  7013: .LC_maxwidth {
                   7014:   max-width: 100%;
                   7015:   height: auto;
                   7016: }
                   7017: 
1.1243    raeburn  7018: .LC_textsize_mobile {
                   7019:   \@media only screen and (max-device-width: 480px) {
                   7020:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   7021:   }
                   7022: }
                   7023: 
1.440     albertel 7024: .LC_icon {
1.771     droeschl 7025:   border: none;
1.790     droeschl 7026:   vertical-align: middle;
1.771     droeschl 7027: }
                   7028: 
1.543     albertel 7029: .LC_docs_spacer {
                   7030:   width: 25px;
                   7031:   height: 1px;
1.771     droeschl 7032:   border: none;
1.543     albertel 7033: }
1.346     albertel 7034: 
1.532     albertel 7035: .LC_internal_info {
1.735     bisitz   7036:   color: #999999;
1.532     albertel 7037: }
                   7038: 
1.794     www      7039: .LC_discussion {
1.1050    www      7040:   background: $data_table_dark;
1.911     bisitz   7041:   border: 1px solid black;
                   7042:   margin: 2px;
1.794     www      7043: }
                   7044: 
                   7045: .LC_disc_action_left {
1.1050    www      7046:   background: $sidebg;
1.911     bisitz   7047:   text-align: left;
1.1050    www      7048:   padding: 4px;
                   7049:   margin: 2px;
1.794     www      7050: }
                   7051: 
                   7052: .LC_disc_action_right {
1.1050    www      7053:   background: $sidebg;
1.911     bisitz   7054:   text-align: right;
1.1050    www      7055:   padding: 4px;
                   7056:   margin: 2px;
1.794     www      7057: }
                   7058: 
                   7059: .LC_disc_new_item {
1.911     bisitz   7060:   background: white;
                   7061:   border: 2px solid red;
1.1050    www      7062:   margin: 4px;
                   7063:   padding: 4px;
1.794     www      7064: }
                   7065: 
                   7066: .LC_disc_old_item {
1.911     bisitz   7067:   background: white;
1.1050    www      7068:   margin: 4px;
                   7069:   padding: 4px;
1.794     www      7070: }
                   7071: 
1.458     albertel 7072: table.LC_pastsubmission {
                   7073:   border: 1px solid black;
                   7074:   margin: 2px;
                   7075: }
                   7076: 
1.924     bisitz   7077: table#LC_menubuttons {
1.345     albertel 7078:   width: 100%;
                   7079:   background: $pgbg;
1.392     albertel 7080:   border: 2px;
1.402     albertel 7081:   border-collapse: separate;
1.803     bisitz   7082:   padding: 0;
1.345     albertel 7083: }
1.392     albertel 7084: 
1.801     tempelho 7085: table#LC_title_bar a {
                   7086:   color: $fontmenu;
                   7087: }
1.836     bisitz   7088: 
1.807     droeschl 7089: table#LC_title_bar {
1.819     tempelho 7090:   clear: both;
1.836     bisitz   7091:   display: none;
1.807     droeschl 7092: }
                   7093: 
1.795     www      7094: table#LC_title_bar,
1.933     droeschl 7095: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 7096: table#LC_title_bar.LC_with_remote {
1.359     albertel 7097:   width: 100%;
1.392     albertel 7098:   border-color: $pgbg;
                   7099:   border-style: solid;
                   7100:   border-width: $border;
1.379     albertel 7101:   background: $pgbg;
1.801     tempelho 7102:   color: $fontmenu;
1.392     albertel 7103:   border-collapse: collapse;
1.803     bisitz   7104:   padding: 0;
1.819     tempelho 7105:   margin: 0;
1.359     albertel 7106: }
1.795     www      7107: 
1.933     droeschl 7108: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 7109:     margin: 0;
                   7110:     padding: 0;
1.933     droeschl 7111:     position: relative;
                   7112:     list-style: none;
1.913     droeschl 7113: }
1.933     droeschl 7114: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 7115:     display: inline;
                   7116: }
1.933     droeschl 7117: 
                   7118: .LC_breadcrumb_tools_navigation {
1.913     droeschl 7119:     padding: 0;
1.933     droeschl 7120:     margin: 0;
                   7121:     float: left;
1.913     droeschl 7122: }
1.933     droeschl 7123: .LC_breadcrumb_tools_tools {
                   7124:     padding: 0;
                   7125:     margin: 0;
1.913     droeschl 7126:     float: right;
                   7127: }
                   7128: 
1.1240    raeburn  7129: .LC_placement_prog {
                   7130:     padding-right: 20px;
                   7131:     font-weight: bold;
                   7132:     font-size: 90%;
                   7133: }
                   7134: 
1.359     albertel 7135: table#LC_title_bar td {
                   7136:   background: $tabbg;
                   7137: }
1.795     www      7138: 
1.911     bisitz   7139: table#LC_menubuttons img {
1.803     bisitz   7140:   border: none;
1.346     albertel 7141: }
1.795     www      7142: 
1.842     droeschl 7143: .LC_breadcrumbs_component {
1.911     bisitz   7144:   float: right;
                   7145:   margin: 0 1em;
1.357     albertel 7146: }
1.842     droeschl 7147: .LC_breadcrumbs_component img {
1.911     bisitz   7148:   vertical-align: middle;
1.777     tempelho 7149: }
1.795     www      7150: 
1.1243    raeburn  7151: .LC_breadcrumbs_hoverable {
                   7152:   background: $sidebg;
                   7153: }
                   7154: 
1.383     albertel 7155: td.LC_table_cell_checkbox {
                   7156:   text-align: center;
                   7157: }
1.795     www      7158: 
                   7159: .LC_fontsize_small {
1.911     bisitz   7160:   font-size: 70%;
1.705     tempelho 7161: }
                   7162: 
1.844     bisitz   7163: #LC_breadcrumbs {
1.911     bisitz   7164:   clear:both;
                   7165:   background: $sidebg;
                   7166:   border-bottom: 1px solid $lg_border_color;
                   7167:   line-height: 2.5em;
1.933     droeschl 7168:   overflow: hidden;
1.911     bisitz   7169:   margin: 0;
                   7170:   padding: 0;
1.995     raeburn  7171:   text-align: left;
1.819     tempelho 7172: }
1.862     bisitz   7173: 
1.1098    bisitz   7174: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   7175:   clear:both;
                   7176:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 7177:   border: 1px solid $sidebg;
1.1098    bisitz   7178:   margin: 0 0 10px 0;
1.966     bisitz   7179:   padding: 3px;
1.995     raeburn  7180:   text-align: left;
1.822     bisitz   7181: }
                   7182: 
1.795     www      7183: .LC_fontsize_medium {
1.911     bisitz   7184:   font-size: 85%;
1.705     tempelho 7185: }
                   7186: 
1.795     www      7187: .LC_fontsize_large {
1.911     bisitz   7188:   font-size: 120%;
1.705     tempelho 7189: }
                   7190: 
1.346     albertel 7191: .LC_menubuttons_inline_text {
                   7192:   color: $font;
1.698     harmsja  7193:   font-size: 90%;
1.701     harmsja  7194:   padding-left:3px;
1.346     albertel 7195: }
                   7196: 
1.934     droeschl 7197: .LC_menubuttons_inline_text img{
                   7198:   vertical-align: middle;
                   7199: }
                   7200: 
1.1051    www      7201: li.LC_menubuttons_inline_text img {
1.951     onken    7202:   cursor:pointer;
1.1002    droeschl 7203:   text-decoration: none;
1.951     onken    7204: }
                   7205: 
1.526     www      7206: .LC_menubuttons_link {
                   7207:   text-decoration: none;
                   7208: }
1.795     www      7209: 
1.522     albertel 7210: .LC_menubuttons_category {
1.521     www      7211:   color: $font;
1.526     www      7212:   background: $pgbg;
1.521     www      7213:   font-size: larger;
                   7214:   font-weight: bold;
                   7215: }
                   7216: 
1.346     albertel 7217: td.LC_menubuttons_text {
1.911     bisitz   7218:   color: $font;
1.346     albertel 7219: }
1.706     harmsja  7220: 
1.346     albertel 7221: .LC_current_location {
                   7222:   background: $tabbg;
                   7223: }
1.795     www      7224: 
1.1286    raeburn  7225: td.LC_zero_height {
                   7226:   line-height: 0; 
                   7227:   cellpadding: 0;
                   7228: }
                   7229: 
1.938     bisitz   7230: table.LC_data_table {
1.347     albertel 7231:   border: 1px solid #000000;
1.402     albertel 7232:   border-collapse: separate;
1.426     albertel 7233:   border-spacing: 1px;
1.610     albertel 7234:   background: $pgbg;
1.347     albertel 7235: }
1.795     www      7236: 
1.422     albertel 7237: .LC_data_table_dense {
                   7238:   font-size: small;
                   7239: }
1.795     www      7240: 
1.507     raeburn  7241: table.LC_nested_outer {
                   7242:   border: 1px solid #000000;
1.589     raeburn  7243:   border-collapse: collapse;
1.803     bisitz   7244:   border-spacing: 0;
1.507     raeburn  7245:   width: 100%;
                   7246: }
1.795     www      7247: 
1.879     raeburn  7248: table.LC_innerpickbox,
1.507     raeburn  7249: table.LC_nested {
1.803     bisitz   7250:   border: none;
1.589     raeburn  7251:   border-collapse: collapse;
1.803     bisitz   7252:   border-spacing: 0;
1.507     raeburn  7253:   width: 100%;
                   7254: }
1.795     www      7255: 
1.911     bisitz   7256: table.LC_data_table tr th,
                   7257: table.LC_calendar tr th,
1.879     raeburn  7258: table.LC_prior_tries tr th,
                   7259: table.LC_innerpickbox tr th {
1.349     albertel 7260:   font-weight: bold;
                   7261:   background-color: $data_table_head;
1.801     tempelho 7262:   color:$fontmenu;
1.701     harmsja  7263:   font-size:90%;
1.347     albertel 7264: }
1.795     www      7265: 
1.879     raeburn  7266: table.LC_innerpickbox tr th,
                   7267: table.LC_innerpickbox tr td {
                   7268:   vertical-align: top;
                   7269: }
                   7270: 
1.711     raeburn  7271: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   7272:   background-color: #CCCCCC;
1.711     raeburn  7273:   font-weight: bold;
                   7274:   text-align: left;
                   7275: }
1.795     www      7276: 
1.912     bisitz   7277: table.LC_data_table tr.LC_odd_row > td {
                   7278:   background-color: $data_table_light;
                   7279:   padding: 2px;
                   7280:   vertical-align: top;
                   7281: }
                   7282: 
1.809     bisitz   7283: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 7284:   background-color: $data_table_light;
1.912     bisitz   7285:   vertical-align: top;
                   7286: }
                   7287: 
                   7288: table.LC_data_table tr.LC_even_row > td {
                   7289:   background-color: $data_table_dark;
1.425     albertel 7290:   padding: 2px;
1.900     bisitz   7291:   vertical-align: top;
1.347     albertel 7292: }
1.795     www      7293: 
1.809     bisitz   7294: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 7295:   background-color: $data_table_dark;
1.900     bisitz   7296:   vertical-align: top;
1.347     albertel 7297: }
1.795     www      7298: 
1.425     albertel 7299: table.LC_data_table tr.LC_data_table_highlight td {
                   7300:   background-color: $data_table_darker;
                   7301: }
1.795     www      7302: 
1.639     raeburn  7303: table.LC_data_table tr td.LC_leftcol_header {
                   7304:   background-color: $data_table_head;
                   7305:   font-weight: bold;
                   7306: }
1.795     www      7307: 
1.451     albertel 7308: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  7309: table.LC_nested tr.LC_empty_row td {
1.421     albertel 7310:   font-weight: bold;
                   7311:   font-style: italic;
                   7312:   text-align: center;
                   7313:   padding: 8px;
1.347     albertel 7314: }
1.795     www      7315: 
1.1114    raeburn  7316: table.LC_data_table tr.LC_empty_row td,
                   7317: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   7318:   background-color: $sidebg;
                   7319: }
                   7320: 
                   7321: table.LC_nested tr.LC_empty_row td {
                   7322:   background-color: #FFFFFF;
                   7323: }
                   7324: 
1.890     droeschl 7325: table.LC_caption {
                   7326: }
                   7327: 
1.507     raeburn  7328: table.LC_nested tr.LC_empty_row td {
1.465     albertel 7329:   padding: 4ex
                   7330: }
1.795     www      7331: 
1.507     raeburn  7332: table.LC_nested_outer tr th {
                   7333:   font-weight: bold;
1.801     tempelho 7334:   color:$fontmenu;
1.507     raeburn  7335:   background-color: $data_table_head;
1.701     harmsja  7336:   font-size: small;
1.507     raeburn  7337:   border-bottom: 1px solid #000000;
                   7338: }
1.795     www      7339: 
1.507     raeburn  7340: table.LC_nested_outer tr td.LC_subheader {
                   7341:   background-color: $data_table_head;
                   7342:   font-weight: bold;
                   7343:   font-size: small;
                   7344:   border-bottom: 1px solid #000000;
                   7345:   text-align: right;
1.451     albertel 7346: }
1.795     www      7347: 
1.507     raeburn  7348: table.LC_nested tr.LC_info_row td {
1.735     bisitz   7349:   background-color: #CCCCCC;
1.451     albertel 7350:   font-weight: bold;
                   7351:   font-size: small;
1.507     raeburn  7352:   text-align: center;
                   7353: }
1.795     www      7354: 
1.589     raeburn  7355: table.LC_nested tr.LC_info_row td.LC_left_item,
                   7356: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  7357:   text-align: left;
1.451     albertel 7358: }
1.795     www      7359: 
1.507     raeburn  7360: table.LC_nested td {
1.735     bisitz   7361:   background-color: #FFFFFF;
1.451     albertel 7362:   font-size: small;
1.507     raeburn  7363: }
1.795     www      7364: 
1.507     raeburn  7365: table.LC_nested_outer tr th.LC_right_item,
                   7366: table.LC_nested tr.LC_info_row td.LC_right_item,
                   7367: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   7368: table.LC_nested tr td.LC_right_item {
1.451     albertel 7369:   text-align: right;
                   7370: }
                   7371: 
1.507     raeburn  7372: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   7373:   background-color: #EEEEEE;
1.451     albertel 7374: }
                   7375: 
1.473     raeburn  7376: table.LC_createuser {
                   7377: }
                   7378: 
                   7379: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  7380:   font-size: small;
1.473     raeburn  7381: }
                   7382: 
                   7383: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   7384:   background-color: #CCCCCC;
1.473     raeburn  7385:   font-weight: bold;
                   7386:   text-align: center;
                   7387: }
                   7388: 
1.349     albertel 7389: table.LC_calendar {
                   7390:   border: 1px solid #000000;
                   7391:   border-collapse: collapse;
1.917     raeburn  7392:   width: 98%;
1.349     albertel 7393: }
1.795     www      7394: 
1.349     albertel 7395: table.LC_calendar_pickdate {
                   7396:   font-size: xx-small;
                   7397: }
1.795     www      7398: 
1.349     albertel 7399: table.LC_calendar tr td {
                   7400:   border: 1px solid #000000;
                   7401:   vertical-align: top;
1.917     raeburn  7402:   width: 14%;
1.349     albertel 7403: }
1.795     www      7404: 
1.349     albertel 7405: table.LC_calendar tr td.LC_calendar_day_empty {
                   7406:   background-color: $data_table_dark;
                   7407: }
1.795     www      7408: 
1.779     bisitz   7409: table.LC_calendar tr td.LC_calendar_day_current {
                   7410:   background-color: $data_table_highlight;
1.777     tempelho 7411: }
1.795     www      7412: 
1.938     bisitz   7413: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 7414:   background-color: $mail_new;
                   7415: }
1.795     www      7416: 
1.938     bisitz   7417: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 7418:   background-color: $mail_new_hover;
                   7419: }
1.795     www      7420: 
1.938     bisitz   7421: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 7422:   background-color: $mail_read;
                   7423: }
1.795     www      7424: 
1.938     bisitz   7425: /*
                   7426: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 7427:   background-color: $mail_read_hover;
                   7428: }
1.938     bisitz   7429: */
1.795     www      7430: 
1.938     bisitz   7431: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 7432:   background-color: $mail_replied;
                   7433: }
1.795     www      7434: 
1.938     bisitz   7435: /*
                   7436: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 7437:   background-color: $mail_replied_hover;
                   7438: }
1.938     bisitz   7439: */
1.795     www      7440: 
1.938     bisitz   7441: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 7442:   background-color: $mail_other;
                   7443: }
1.795     www      7444: 
1.938     bisitz   7445: /*
                   7446: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 7447:   background-color: $mail_other_hover;
                   7448: }
1.938     bisitz   7449: */
1.494     raeburn  7450: 
1.777     tempelho 7451: table.LC_data_table tr > td.LC_browser_file,
                   7452: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   7453:   background: #AAEE77;
1.389     albertel 7454: }
1.795     www      7455: 
1.777     tempelho 7456: table.LC_data_table tr > td.LC_browser_file_locked,
                   7457: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 7458:   background: #FFAA99;
1.387     albertel 7459: }
1.795     www      7460: 
1.777     tempelho 7461: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   7462:   background: #888888;
1.779     bisitz   7463: }
1.795     www      7464: 
1.777     tempelho 7465: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   7466: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   7467:   background: #F8F866;
1.777     tempelho 7468: }
1.795     www      7469: 
1.696     bisitz   7470: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   7471:   background: #E0E8FF;
1.387     albertel 7472: }
1.696     bisitz   7473: 
1.707     bisitz   7474: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   7475:   /* background: #77FF77; */
1.707     bisitz   7476: }
1.795     www      7477: 
1.707     bisitz   7478: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   7479:   border-right: 8px solid #FFFF77;
1.707     bisitz   7480: }
1.795     www      7481: 
1.707     bisitz   7482: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   7483:   border-right: 8px solid #FFAA77;
1.707     bisitz   7484: }
1.795     www      7485: 
1.707     bisitz   7486: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   7487:   border-right: 8px solid #FF7777;
1.707     bisitz   7488: }
1.795     www      7489: 
1.707     bisitz   7490: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   7491:   border-right: 8px solid #AAFF77;
1.707     bisitz   7492: }
1.795     www      7493: 
1.707     bisitz   7494: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   7495:   border-right: 8px solid #11CC55;
1.707     bisitz   7496: }
                   7497: 
1.388     albertel 7498: span.LC_current_location {
1.701     harmsja  7499:   font-size:larger;
1.388     albertel 7500:   background: $pgbg;
                   7501: }
1.387     albertel 7502: 
1.1029    www      7503: span.LC_current_nav_location {
                   7504:   font-weight:bold;
                   7505:   background: $sidebg;
                   7506: }
                   7507: 
1.395     albertel 7508: span.LC_parm_menu_item {
                   7509:   font-size: larger;
                   7510: }
1.795     www      7511: 
1.395     albertel 7512: span.LC_parm_scope_all {
                   7513:   color: red;
                   7514: }
1.795     www      7515: 
1.395     albertel 7516: span.LC_parm_scope_folder {
                   7517:   color: green;
                   7518: }
1.795     www      7519: 
1.395     albertel 7520: span.LC_parm_scope_resource {
                   7521:   color: orange;
                   7522: }
1.795     www      7523: 
1.395     albertel 7524: span.LC_parm_part {
                   7525:   color: blue;
                   7526: }
1.795     www      7527: 
1.911     bisitz   7528: span.LC_parm_folder,
                   7529: span.LC_parm_symb {
1.395     albertel 7530:   font-size: x-small;
                   7531:   font-family: $mono;
                   7532:   color: #AAAAAA;
                   7533: }
                   7534: 
1.977     bisitz   7535: ul.LC_parm_parmlist li {
                   7536:   display: inline-block;
                   7537:   padding: 0.3em 0.8em;
                   7538:   vertical-align: top;
                   7539:   width: 150px;
                   7540:   border-top:1px solid $lg_border_color;
                   7541: }
                   7542: 
1.795     www      7543: td.LC_parm_overview_level_menu,
                   7544: td.LC_parm_overview_map_menu,
                   7545: td.LC_parm_overview_parm_selectors,
                   7546: td.LC_parm_overview_restrictions  {
1.396     albertel 7547:   border: 1px solid black;
                   7548:   border-collapse: collapse;
                   7549: }
1.795     www      7550: 
1.1285    raeburn  7551: span.LC_parm_recursive,
                   7552: td.LC_parm_recursive {
                   7553:   font-weight: bold;
                   7554:   font-size: smaller;
                   7555: }
                   7556: 
1.396     albertel 7557: table.LC_parm_overview_restrictions td {
                   7558:   border-width: 1px 4px 1px 4px;
                   7559:   border-style: solid;
                   7560:   border-color: $pgbg;
                   7561:   text-align: center;
                   7562: }
1.795     www      7563: 
1.396     albertel 7564: table.LC_parm_overview_restrictions th {
                   7565:   background: $tabbg;
                   7566:   border-width: 1px 4px 1px 4px;
                   7567:   border-style: solid;
                   7568:   border-color: $pgbg;
                   7569: }
1.795     www      7570: 
1.398     albertel 7571: table#LC_helpmenu {
1.803     bisitz   7572:   border: none;
1.398     albertel 7573:   height: 55px;
1.803     bisitz   7574:   border-spacing: 0;
1.398     albertel 7575: }
                   7576: 
                   7577: table#LC_helpmenu fieldset legend {
                   7578:   font-size: larger;
                   7579: }
1.795     www      7580: 
1.397     albertel 7581: table#LC_helpmenu_links {
                   7582:   width: 100%;
                   7583:   border: 1px solid black;
                   7584:   background: $pgbg;
1.803     bisitz   7585:   padding: 0;
1.397     albertel 7586:   border-spacing: 1px;
                   7587: }
1.795     www      7588: 
1.397     albertel 7589: table#LC_helpmenu_links tr td {
                   7590:   padding: 1px;
                   7591:   background: $tabbg;
1.399     albertel 7592:   text-align: center;
                   7593:   font-weight: bold;
1.397     albertel 7594: }
1.396     albertel 7595: 
1.795     www      7596: table#LC_helpmenu_links a:link,
                   7597: table#LC_helpmenu_links a:visited,
1.397     albertel 7598: table#LC_helpmenu_links a:active {
                   7599:   text-decoration: none;
                   7600:   color: $font;
                   7601: }
1.795     www      7602: 
1.397     albertel 7603: table#LC_helpmenu_links a:hover {
                   7604:   text-decoration: underline;
                   7605:   color: $vlink;
                   7606: }
1.396     albertel 7607: 
1.417     albertel 7608: .LC_chrt_popup_exists {
                   7609:   border: 1px solid #339933;
                   7610:   margin: -1px;
                   7611: }
1.795     www      7612: 
1.417     albertel 7613: .LC_chrt_popup_up {
                   7614:   border: 1px solid yellow;
                   7615:   margin: -1px;
                   7616: }
1.795     www      7617: 
1.417     albertel 7618: .LC_chrt_popup {
                   7619:   border: 1px solid #8888FF;
                   7620:   background: #CCCCFF;
                   7621: }
1.795     www      7622: 
1.421     albertel 7623: table.LC_pick_box {
                   7624:   border-collapse: separate;
                   7625:   background: white;
                   7626:   border: 1px solid black;
                   7627:   border-spacing: 1px;
                   7628: }
1.795     www      7629: 
1.421     albertel 7630: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   7631:   background: $sidebg;
1.421     albertel 7632:   font-weight: bold;
1.900     bisitz   7633:   text-align: left;
1.740     bisitz   7634:   vertical-align: top;
1.421     albertel 7635:   width: 184px;
                   7636:   padding: 8px;
                   7637: }
1.795     www      7638: 
1.579     raeburn  7639: table.LC_pick_box td.LC_pick_box_value {
                   7640:   text-align: left;
                   7641:   padding: 8px;
                   7642: }
1.795     www      7643: 
1.579     raeburn  7644: table.LC_pick_box td.LC_pick_box_select {
                   7645:   text-align: left;
                   7646:   padding: 8px;
                   7647: }
1.795     www      7648: 
1.424     albertel 7649: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   7650:   padding: 0;
1.421     albertel 7651:   height: 1px;
                   7652:   background: black;
                   7653: }
1.795     www      7654: 
1.421     albertel 7655: table.LC_pick_box td.LC_pick_box_submit {
                   7656:   text-align: right;
                   7657: }
1.795     www      7658: 
1.579     raeburn  7659: table.LC_pick_box td.LC_evenrow_value {
                   7660:   text-align: left;
                   7661:   padding: 8px;
                   7662:   background-color: $data_table_light;
                   7663: }
1.795     www      7664: 
1.579     raeburn  7665: table.LC_pick_box td.LC_oddrow_value {
                   7666:   text-align: left;
                   7667:   padding: 8px;
                   7668:   background-color: $data_table_light;
                   7669: }
1.795     www      7670: 
1.579     raeburn  7671: span.LC_helpform_receipt_cat {
                   7672:   font-weight: bold;
                   7673: }
1.795     www      7674: 
1.424     albertel 7675: table.LC_group_priv_box {
                   7676:   background: white;
                   7677:   border: 1px solid black;
                   7678:   border-spacing: 1px;
                   7679: }
1.795     www      7680: 
1.424     albertel 7681: table.LC_group_priv_box td.LC_pick_box_title {
                   7682:   background: $tabbg;
                   7683:   font-weight: bold;
                   7684:   text-align: right;
                   7685:   width: 184px;
                   7686: }
1.795     www      7687: 
1.424     albertel 7688: table.LC_group_priv_box td.LC_groups_fixed {
                   7689:   background: $data_table_light;
                   7690:   text-align: center;
                   7691: }
1.795     www      7692: 
1.424     albertel 7693: table.LC_group_priv_box td.LC_groups_optional {
                   7694:   background: $data_table_dark;
                   7695:   text-align: center;
                   7696: }
1.795     www      7697: 
1.424     albertel 7698: table.LC_group_priv_box td.LC_groups_functionality {
                   7699:   background: $data_table_darker;
                   7700:   text-align: center;
                   7701:   font-weight: bold;
                   7702: }
1.795     www      7703: 
1.424     albertel 7704: table.LC_group_priv td {
                   7705:   text-align: left;
1.803     bisitz   7706:   padding: 0;
1.424     albertel 7707: }
                   7708: 
                   7709: .LC_navbuttons {
                   7710:   margin: 2ex 0ex 2ex 0ex;
                   7711: }
1.795     www      7712: 
1.423     albertel 7713: .LC_topic_bar {
                   7714:   font-weight: bold;
                   7715:   background: $tabbg;
1.918     wenzelju 7716:   margin: 1em 0em 1em 2em;
1.805     bisitz   7717:   padding: 3px;
1.918     wenzelju 7718:   font-size: 1.2em;
1.423     albertel 7719: }
1.795     www      7720: 
1.423     albertel 7721: .LC_topic_bar span {
1.918     wenzelju 7722:   left: 0.5em;
                   7723:   position: absolute;
1.423     albertel 7724:   vertical-align: middle;
1.918     wenzelju 7725:   font-size: 1.2em;
1.423     albertel 7726: }
1.795     www      7727: 
1.423     albertel 7728: table.LC_course_group_status {
                   7729:   margin: 20px;
                   7730: }
1.795     www      7731: 
1.423     albertel 7732: table.LC_status_selector td {
                   7733:   vertical-align: top;
                   7734:   text-align: center;
1.424     albertel 7735:   padding: 4px;
                   7736: }
1.795     www      7737: 
1.599     albertel 7738: div.LC_feedback_link {
1.616     albertel 7739:   clear: both;
1.829     kalberla 7740:   background: $sidebg;
1.779     bisitz   7741:   width: 100%;
1.829     kalberla 7742:   padding-bottom: 10px;
                   7743:   border: 1px $tabbg solid;
1.833     kalberla 7744:   height: 22px;
                   7745:   line-height: 22px;
                   7746:   padding-top: 5px;
                   7747: }
                   7748: 
                   7749: div.LC_feedback_link img {
                   7750:   height: 22px;
1.867     kalberla 7751:   vertical-align:middle;
1.829     kalberla 7752: }
                   7753: 
1.911     bisitz   7754: div.LC_feedback_link a {
1.829     kalberla 7755:   text-decoration: none;
1.489     raeburn  7756: }
1.795     www      7757: 
1.867     kalberla 7758: div.LC_comblock {
1.911     bisitz   7759:   display:inline;
1.867     kalberla 7760:   color:$font;
                   7761:   font-size:90%;
                   7762: }
                   7763: 
                   7764: div.LC_feedback_link div.LC_comblock {
                   7765:   padding-left:5px;
                   7766: }
                   7767: 
                   7768: div.LC_feedback_link div.LC_comblock a {
                   7769:   color:$font;
                   7770: }
                   7771: 
1.489     raeburn  7772: span.LC_feedback_link {
1.858     bisitz   7773:   /* background: $feedback_link_bg; */
1.599     albertel 7774:   font-size: larger;
                   7775: }
1.795     www      7776: 
1.599     albertel 7777: span.LC_message_link {
1.858     bisitz   7778:   /* background: $feedback_link_bg; */
1.599     albertel 7779:   font-size: larger;
                   7780:   position: absolute;
                   7781:   right: 1em;
1.489     raeburn  7782: }
1.421     albertel 7783: 
1.515     albertel 7784: table.LC_prior_tries {
1.524     albertel 7785:   border: 1px solid #000000;
                   7786:   border-collapse: separate;
                   7787:   border-spacing: 1px;
1.515     albertel 7788: }
1.523     albertel 7789: 
1.515     albertel 7790: table.LC_prior_tries td {
1.524     albertel 7791:   padding: 2px;
1.515     albertel 7792: }
1.523     albertel 7793: 
                   7794: .LC_answer_correct {
1.795     www      7795:   background: lightgreen;
                   7796:   color: darkgreen;
                   7797:   padding: 6px;
1.523     albertel 7798: }
1.795     www      7799: 
1.523     albertel 7800: .LC_answer_charged_try {
1.797     www      7801:   background: #FFAAAA;
1.795     www      7802:   color: darkred;
                   7803:   padding: 6px;
1.523     albertel 7804: }
1.795     www      7805: 
1.779     bisitz   7806: .LC_answer_not_charged_try,
1.523     albertel 7807: .LC_answer_no_grade,
                   7808: .LC_answer_late {
1.795     www      7809:   background: lightyellow;
1.523     albertel 7810:   color: black;
1.795     www      7811:   padding: 6px;
1.523     albertel 7812: }
1.795     www      7813: 
1.523     albertel 7814: .LC_answer_previous {
1.795     www      7815:   background: lightblue;
                   7816:   color: darkblue;
                   7817:   padding: 6px;
1.523     albertel 7818: }
1.795     www      7819: 
1.779     bisitz   7820: .LC_answer_no_message {
1.777     tempelho 7821:   background: #FFFFFF;
                   7822:   color: black;
1.795     www      7823:   padding: 6px;
1.779     bisitz   7824: }
1.795     www      7825: 
1.1334    raeburn  7826: .LC_answer_unknown,
                   7827: .LC_answer_warning {
1.779     bisitz   7828:   background: orange;
                   7829:   color: black;
1.795     www      7830:   padding: 6px;
1.777     tempelho 7831: }
1.795     www      7832: 
1.529     albertel 7833: span.LC_prior_numerical,
                   7834: span.LC_prior_string,
                   7835: span.LC_prior_custom,
                   7836: span.LC_prior_reaction,
                   7837: span.LC_prior_math {
1.925     bisitz   7838:   font-family: $mono;
1.523     albertel 7839:   white-space: pre;
                   7840: }
                   7841: 
1.525     albertel 7842: span.LC_prior_string {
1.925     bisitz   7843:   font-family: $mono;
1.525     albertel 7844:   white-space: pre;
                   7845: }
                   7846: 
1.523     albertel 7847: table.LC_prior_option {
                   7848:   width: 100%;
                   7849:   border-collapse: collapse;
                   7850: }
1.795     www      7851: 
1.911     bisitz   7852: table.LC_prior_rank,
1.795     www      7853: table.LC_prior_match {
1.528     albertel 7854:   border-collapse: collapse;
                   7855: }
1.795     www      7856: 
1.528     albertel 7857: table.LC_prior_option tr td,
                   7858: table.LC_prior_rank tr td,
                   7859: table.LC_prior_match tr td {
1.524     albertel 7860:   border: 1px solid #000000;
1.515     albertel 7861: }
                   7862: 
1.855     bisitz   7863: .LC_nobreak {
1.544     albertel 7864:   white-space: nowrap;
1.519     raeburn  7865: }
                   7866: 
1.576     raeburn  7867: span.LC_cusr_emph {
                   7868:   font-style: italic;
                   7869: }
                   7870: 
1.633     raeburn  7871: span.LC_cusr_subheading {
                   7872:   font-weight: normal;
                   7873:   font-size: 85%;
                   7874: }
                   7875: 
1.861     bisitz   7876: div.LC_docs_entry_move {
1.859     bisitz   7877:   border: 1px solid #BBBBBB;
1.545     albertel 7878:   background: #DDDDDD;
1.861     bisitz   7879:   width: 22px;
1.859     bisitz   7880:   padding: 1px;
                   7881:   margin: 0;
1.545     albertel 7882: }
                   7883: 
1.861     bisitz   7884: table.LC_data_table tr > td.LC_docs_entry_commands,
                   7885: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 7886:   font-size: x-small;
                   7887: }
1.795     www      7888: 
1.861     bisitz   7889: .LC_docs_entry_parameter {
                   7890:   white-space: nowrap;
                   7891: }
                   7892: 
1.544     albertel 7893: .LC_docs_copy {
1.545     albertel 7894:   color: #000099;
1.544     albertel 7895: }
1.795     www      7896: 
1.544     albertel 7897: .LC_docs_cut {
1.545     albertel 7898:   color: #550044;
1.544     albertel 7899: }
1.795     www      7900: 
1.544     albertel 7901: .LC_docs_rename {
1.545     albertel 7902:   color: #009900;
1.544     albertel 7903: }
1.795     www      7904: 
1.544     albertel 7905: .LC_docs_remove {
1.545     albertel 7906:   color: #990000;
                   7907: }
                   7908: 
1.1284    raeburn  7909: .LC_docs_alias {
                   7910:   color: #440055;  
                   7911: }
                   7912: 
1.1286    raeburn  7913: .LC_domprefs_email,
1.1284    raeburn  7914: .LC_docs_alias_name,
1.547     albertel 7915: .LC_docs_reinit_warn,
                   7916: .LC_docs_ext_edit {
                   7917:   font-size: x-small;
                   7918: }
                   7919: 
1.545     albertel 7920: table.LC_docs_adddocs td,
                   7921: table.LC_docs_adddocs th {
                   7922:   border: 1px solid #BBBBBB;
                   7923:   padding: 4px;
                   7924:   background: #DDDDDD;
1.543     albertel 7925: }
                   7926: 
1.584     albertel 7927: table.LC_sty_begin {
                   7928:   background: #BBFFBB;
                   7929: }
1.795     www      7930: 
1.584     albertel 7931: table.LC_sty_end {
                   7932:   background: #FFBBBB;
                   7933: }
                   7934: 
1.589     raeburn  7935: table.LC_double_column {
1.803     bisitz   7936:   border-width: 0;
1.589     raeburn  7937:   border-collapse: collapse;
                   7938:   width: 100%;
                   7939:   padding: 2px;
                   7940: }
                   7941: 
                   7942: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  7943:   top: 2px;
1.589     raeburn  7944:   left: 2px;
                   7945:   width: 47%;
                   7946:   vertical-align: top;
                   7947: }
                   7948: 
                   7949: table.LC_double_column tr td.LC_right_col {
                   7950:   top: 2px;
1.779     bisitz   7951:   right: 2px;
1.589     raeburn  7952:   width: 47%;
                   7953:   vertical-align: top;
                   7954: }
                   7955: 
1.591     raeburn  7956: div.LC_left_float {
                   7957:   float: left;
                   7958:   padding-right: 5%;
1.597     albertel 7959:   padding-bottom: 4px;
1.591     raeburn  7960: }
                   7961: 
                   7962: div.LC_clear_float_header {
1.597     albertel 7963:   padding-bottom: 2px;
1.591     raeburn  7964: }
                   7965: 
                   7966: div.LC_clear_float_footer {
1.597     albertel 7967:   padding-top: 10px;
1.591     raeburn  7968:   clear: both;
                   7969: }
                   7970: 
1.597     albertel 7971: div.LC_grade_show_user {
1.941     bisitz   7972: /*  border-left: 5px solid $sidebg; */
                   7973:   border-top: 5px solid #000000;
                   7974:   margin: 50px 0 0 0;
1.936     bisitz   7975:   padding: 15px 0 5px 10px;
1.597     albertel 7976: }
1.795     www      7977: 
1.936     bisitz   7978: div.LC_grade_show_user_odd_row {
1.941     bisitz   7979: /*  border-left: 5px solid #000000; */
                   7980: }
                   7981: 
                   7982: div.LC_grade_show_user div.LC_Box {
                   7983:   margin-right: 50px;
1.597     albertel 7984: }
                   7985: 
                   7986: div.LC_grade_submissions,
                   7987: div.LC_grade_message_center,
1.936     bisitz   7988: div.LC_grade_info_links {
1.597     albertel 7989:   margin: 5px;
                   7990:   width: 99%;
                   7991:   background: #FFFFFF;
                   7992: }
1.795     www      7993: 
1.597     albertel 7994: div.LC_grade_submissions_header,
1.936     bisitz   7995: div.LC_grade_message_center_header {
1.705     tempelho 7996:   font-weight: bold;
                   7997:   font-size: large;
1.597     albertel 7998: }
1.795     www      7999: 
1.597     albertel 8000: div.LC_grade_submissions_body,
1.936     bisitz   8001: div.LC_grade_message_center_body {
1.597     albertel 8002:   border: 1px solid black;
                   8003:   width: 99%;
                   8004:   background: #FFFFFF;
                   8005: }
1.795     www      8006: 
1.613     albertel 8007: table.LC_scantron_action {
                   8008:   width: 100%;
                   8009: }
1.795     www      8010: 
1.613     albertel 8011: table.LC_scantron_action tr th {
1.698     harmsja  8012:   font-weight:bold;
                   8013:   font-style:normal;
1.613     albertel 8014: }
1.795     www      8015: 
1.779     bisitz   8016: .LC_edit_problem_header,
1.614     albertel 8017: div.LC_edit_problem_footer {
1.705     tempelho 8018:   font-weight: normal;
                   8019:   font-size:  medium;
1.602     albertel 8020:   margin: 2px;
1.1060    bisitz   8021:   background-color: $sidebg;
1.600     albertel 8022: }
1.795     www      8023: 
1.600     albertel 8024: div.LC_edit_problem_header,
1.602     albertel 8025: div.LC_edit_problem_header div,
1.614     albertel 8026: div.LC_edit_problem_footer,
                   8027: div.LC_edit_problem_footer div,
1.602     albertel 8028: div.LC_edit_problem_editxml_header,
                   8029: div.LC_edit_problem_editxml_header div {
1.1205    golterma 8030:   z-index: 100;
1.600     albertel 8031: }
1.795     www      8032: 
1.600     albertel 8033: div.LC_edit_problem_header_title {
1.705     tempelho 8034:   font-weight: bold;
                   8035:   font-size: larger;
1.602     albertel 8036:   background: $tabbg;
                   8037:   padding: 3px;
1.1060    bisitz   8038:   margin: 0 0 5px 0;
1.602     albertel 8039: }
1.795     www      8040: 
1.602     albertel 8041: table.LC_edit_problem_header_title {
                   8042:   width: 100%;
1.600     albertel 8043:   background: $tabbg;
1.602     albertel 8044: }
                   8045: 
1.1205    golterma 8046: div.LC_edit_actionbar {
                   8047:     background-color: $sidebg;
1.1218    droeschl 8048:     margin: 0;
                   8049:     padding: 0;
                   8050:     line-height: 200%;
1.602     albertel 8051: }
1.795     www      8052: 
1.1218    droeschl 8053: div.LC_edit_actionbar div{
                   8054:     padding: 0;
                   8055:     margin: 0;
                   8056:     display: inline-block;
1.600     albertel 8057: }
1.795     www      8058: 
1.1124    bisitz   8059: .LC_edit_opt {
                   8060:   padding-left: 1em;
                   8061:   white-space: nowrap;
                   8062: }
                   8063: 
1.1152    golterma 8064: .LC_edit_problem_latexhelper{
                   8065:     text-align: right;
                   8066: }
                   8067: 
                   8068: #LC_edit_problem_colorful div{
                   8069:     margin-left: 40px;
                   8070: }
                   8071: 
1.1205    golterma 8072: #LC_edit_problem_codemirror div{
                   8073:     margin-left: 0px;
                   8074: }
                   8075: 
1.911     bisitz   8076: img.stift {
1.803     bisitz   8077:   border-width: 0;
                   8078:   vertical-align: middle;
1.677     riegler  8079: }
1.680     riegler  8080: 
1.923     bisitz   8081: table td.LC_mainmenu_col_fieldset {
1.680     riegler  8082:   vertical-align: top;
1.777     tempelho 8083: }
1.795     www      8084: 
1.716     raeburn  8085: div.LC_createcourse {
1.911     bisitz   8086:   margin: 10px 10px 10px 10px;
1.716     raeburn  8087: }
                   8088: 
1.917     raeburn  8089: .LC_dccid {
1.1130    raeburn  8090:   float: right;
1.917     raeburn  8091:   margin: 0.2em 0 0 0;
                   8092:   padding: 0;
                   8093:   font-size: 90%;
                   8094:   display:none;
                   8095: }
                   8096: 
1.897     wenzelju 8097: ol.LC_primary_menu a:hover,
1.721     harmsja  8098: ol#LC_MenuBreadcrumbs a:hover,
                   8099: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 8100: ul#LC_secondary_menu a:hover,
1.721     harmsja  8101: .LC_FormSectionClearButton input:hover
1.795     www      8102: ul.LC_TabContent   li:hover a {
1.952     onken    8103:   color:$button_hover;
1.911     bisitz   8104:   text-decoration:none;
1.693     droeschl 8105: }
                   8106: 
1.779     bisitz   8107: h1 {
1.911     bisitz   8108:   padding: 0;
                   8109:   line-height:130%;
1.693     droeschl 8110: }
1.698     harmsja  8111: 
1.911     bisitz   8112: h2,
                   8113: h3,
                   8114: h4,
                   8115: h5,
                   8116: h6 {
                   8117:   margin: 5px 0 5px 0;
                   8118:   padding: 0;
                   8119:   line-height:130%;
1.693     droeschl 8120: }
1.795     www      8121: 
                   8122: .LC_hcell {
1.911     bisitz   8123:   padding:3px 15px 3px 15px;
                   8124:   margin: 0;
                   8125:   background-color:$tabbg;
                   8126:   color:$fontmenu;
                   8127:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 8128: }
1.795     www      8129: 
1.840     bisitz   8130: .LC_Box > .LC_hcell {
1.911     bisitz   8131:   margin: 0 -10px 10px -10px;
1.835     bisitz   8132: }
                   8133: 
1.721     harmsja  8134: .LC_noBorder {
1.911     bisitz   8135:   border: 0;
1.698     harmsja  8136: }
1.693     droeschl 8137: 
1.721     harmsja  8138: .LC_FormSectionClearButton input {
1.911     bisitz   8139:   background-color:transparent;
                   8140:   border: none;
                   8141:   cursor:pointer;
                   8142:   text-decoration:underline;
1.693     droeschl 8143: }
1.763     bisitz   8144: 
                   8145: .LC_help_open_topic {
1.911     bisitz   8146:   color: #FFFFFF;
                   8147:   background-color: #EEEEFF;
                   8148:   margin: 1px;
                   8149:   padding: 4px;
                   8150:   border: 1px solid #000033;
                   8151:   white-space: nowrap;
                   8152:   /* vertical-align: middle; */
1.759     neumanie 8153: }
1.693     droeschl 8154: 
1.911     bisitz   8155: dl,
                   8156: ul,
                   8157: div,
                   8158: fieldset {
                   8159:   margin: 10px 10px 10px 0;
                   8160:   /* overflow: hidden; */
1.693     droeschl 8161: }
1.795     www      8162: 
1.1211    raeburn  8163: article.geogebraweb div {
                   8164:     margin: 0;
                   8165: }
                   8166: 
1.838     bisitz   8167: fieldset > legend {
1.911     bisitz   8168:   font-weight: bold;
                   8169:   padding: 0 5px 0 5px;
1.838     bisitz   8170: }
                   8171: 
1.813     bisitz   8172: #LC_nav_bar {
1.911     bisitz   8173:   float: left;
1.995     raeburn  8174:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   8175:   margin: 0 0 2px 0;
1.807     droeschl 8176: }
                   8177: 
1.916     droeschl 8178: #LC_realm {
                   8179:   margin: 0.2em 0 0 0;
                   8180:   padding: 0;
                   8181:   font-weight: bold;
                   8182:   text-align: center;
1.995     raeburn  8183:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 8184: }
                   8185: 
1.911     bisitz   8186: #LC_nav_bar em {
                   8187:   font-weight: bold;
                   8188:   font-style: normal;
1.807     droeschl 8189: }
                   8190: 
1.897     wenzelju 8191: ol.LC_primary_menu {
1.934     droeschl 8192:   margin: 0;
1.1076    raeburn  8193:   padding: 0;
1.807     droeschl 8194: }
                   8195: 
1.852     droeschl 8196: ol#LC_PathBreadcrumbs {
1.911     bisitz   8197:   margin: 0;
1.693     droeschl 8198: }
                   8199: 
1.897     wenzelju 8200: ol.LC_primary_menu li {
1.1076    raeburn  8201:   color: RGB(80, 80, 80);
                   8202:   vertical-align: middle;
                   8203:   text-align: left;
                   8204:   list-style: none;
1.1205    golterma 8205:   position: relative;
1.1076    raeburn  8206:   float: left;
1.1205    golterma 8207:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   8208:   line-height: 1.5em;
1.1076    raeburn  8209: }
                   8210: 
1.1205    golterma 8211: ol.LC_primary_menu li a,
                   8212: ol.LC_primary_menu li p {
1.1076    raeburn  8213:   display: block;
                   8214:   margin: 0;
                   8215:   padding: 0 5px 0 10px;
                   8216:   text-decoration: none;
                   8217: }
                   8218: 
1.1205    golterma 8219: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   8220:   display: inline-block;
                   8221:   width: 95%;
                   8222:   text-align: left;
                   8223: }
                   8224: 
                   8225: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   8226:   display: inline-block;	
                   8227:   width: 5%;
                   8228:   float: right;
                   8229:   text-align: right;
                   8230:   font-size: 70%;
                   8231: }
                   8232: 
                   8233: ol.LC_primary_menu ul {
1.1076    raeburn  8234:   display: none;
1.1205    golterma 8235:   width: 15em;
1.1076    raeburn  8236:   background-color: $data_table_light;
1.1205    golterma 8237:   position: absolute;
                   8238:   top: 100%;
1.1076    raeburn  8239: }
                   8240: 
1.1205    golterma 8241: ol.LC_primary_menu ul ul {
                   8242:   left: 100%;
                   8243:   top: 0;
                   8244: }
                   8245: 
                   8246: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076    raeburn  8247:   display: block;
                   8248:   position: absolute;
                   8249:   margin: 0;
                   8250:   padding: 0;
1.1078    raeburn  8251:   z-index: 2;
1.1076    raeburn  8252: }
                   8253: 
                   8254: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205    golterma 8255: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076    raeburn  8256:   font-size: 90%;
1.911     bisitz   8257:   vertical-align: top;
1.1076    raeburn  8258:   float: none;
1.1079    raeburn  8259:   border-left: 1px solid black;
                   8260:   border-right: 1px solid black;
1.1205    golterma 8261: /* A dark bottom border to visualize different menu options; 
                   8262: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   8263:   border-bottom: 1px solid $data_table_dark; 
1.1076    raeburn  8264: }
                   8265: 
1.1205    golterma 8266: ol.LC_primary_menu li li p:hover {
                   8267:   color:$button_hover;
                   8268:   text-decoration:none;
                   8269:   background-color:$data_table_dark;
1.1076    raeburn  8270: }
                   8271: 
                   8272: ol.LC_primary_menu li li a:hover {
                   8273:    color:$button_hover;
                   8274:    background-color:$data_table_dark;
1.693     droeschl 8275: }
                   8276: 
1.1205    golterma 8277: /* Font-size equal to the size of the predecessors*/
                   8278: ol.LC_primary_menu li:hover li li {
                   8279:   font-size: 100%;
                   8280: }
                   8281: 
1.897     wenzelju 8282: ol.LC_primary_menu li img {
1.911     bisitz   8283:   vertical-align: bottom;
1.934     droeschl 8284:   height: 1.1em;
1.1077    raeburn  8285:   margin: 0.2em 0 0 0;
1.693     droeschl 8286: }
                   8287: 
1.897     wenzelju 8288: ol.LC_primary_menu a {
1.911     bisitz   8289:   color: RGB(80, 80, 80);
                   8290:   text-decoration: none;
1.693     droeschl 8291: }
1.795     www      8292: 
1.949     droeschl 8293: ol.LC_primary_menu a.LC_new_message {
                   8294:   font-weight:bold;
                   8295:   color: darkred;
                   8296: }
                   8297: 
1.975     raeburn  8298: ol.LC_docs_parameters {
                   8299:   margin-left: 0;
                   8300:   padding: 0;
                   8301:   list-style: none;
                   8302: }
                   8303: 
                   8304: ol.LC_docs_parameters li {
                   8305:   margin: 0;
                   8306:   padding-right: 20px;
                   8307:   display: inline;
                   8308: }
                   8309: 
1.976     raeburn  8310: ol.LC_docs_parameters li:before {
                   8311:   content: "\\002022 \\0020";
                   8312: }
                   8313: 
                   8314: li.LC_docs_parameters_title {
                   8315:   font-weight: bold;
                   8316: }
                   8317: 
                   8318: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   8319:   content: "";
                   8320: }
                   8321: 
1.897     wenzelju 8322: ul#LC_secondary_menu {
1.1107    raeburn  8323:   clear: right;
1.911     bisitz   8324:   color: $fontmenu;
                   8325:   background: $tabbg;
                   8326:   list-style: none;
                   8327:   padding: 0;
                   8328:   margin: 0;
                   8329:   width: 100%;
1.995     raeburn  8330:   text-align: left;
1.1107    raeburn  8331:   float: left;
1.808     droeschl 8332: }
                   8333: 
1.897     wenzelju 8334: ul#LC_secondary_menu li {
1.911     bisitz   8335:   font-weight: bold;
                   8336:   line-height: 1.8em;
1.1107    raeburn  8337:   border-right: 1px solid black;
                   8338:   float: left;
                   8339: }
                   8340: 
                   8341: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   8342:   background-color: $data_table_light;
                   8343: }
                   8344: 
                   8345: ul#LC_secondary_menu li a {
1.911     bisitz   8346:   padding: 0 0.8em;
1.1107    raeburn  8347: }
                   8348: 
                   8349: ul#LC_secondary_menu li ul {
                   8350:   display: none;
                   8351: }
                   8352: 
                   8353: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   8354:   display: block;
                   8355:   position: absolute;
                   8356:   margin: 0;
                   8357:   padding: 0;
                   8358:   list-style:none;
                   8359:   float: none;
                   8360:   background-color: $data_table_light;
                   8361:   z-index: 2;
                   8362:   margin-left: -1px;
                   8363: }
                   8364: 
                   8365: ul#LC_secondary_menu li ul li {
                   8366:   font-size: 90%;
                   8367:   vertical-align: top;
                   8368:   border-left: 1px solid black;
1.911     bisitz   8369:   border-right: 1px solid black;
1.1119    raeburn  8370:   background-color: $data_table_light;
1.1107    raeburn  8371:   list-style:none;
                   8372:   float: none;
                   8373: }
                   8374: 
                   8375: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   8376:   background-color: $data_table_dark;
1.807     droeschl 8377: }
                   8378: 
1.847     tempelho 8379: ul.LC_TabContent {
1.911     bisitz   8380:   display:block;
                   8381:   background: $sidebg;
                   8382:   border-bottom: solid 1px $lg_border_color;
                   8383:   list-style:none;
1.1020    raeburn  8384:   margin: -1px -10px 0 -10px;
1.911     bisitz   8385:   padding: 0;
1.693     droeschl 8386: }
                   8387: 
1.795     www      8388: ul.LC_TabContent li,
                   8389: ul.LC_TabContentBigger li {
1.911     bisitz   8390:   float:left;
1.741     harmsja  8391: }
1.795     www      8392: 
1.897     wenzelju 8393: ul#LC_secondary_menu li a {
1.911     bisitz   8394:   color: $fontmenu;
                   8395:   text-decoration: none;
1.693     droeschl 8396: }
1.795     www      8397: 
1.721     harmsja  8398: ul.LC_TabContent {
1.952     onken    8399:   min-height:20px;
1.721     harmsja  8400: }
1.795     www      8401: 
                   8402: ul.LC_TabContent li {
1.911     bisitz   8403:   vertical-align:middle;
1.959     onken    8404:   padding: 0 16px 0 10px;
1.911     bisitz   8405:   background-color:$tabbg;
                   8406:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  8407:   border-left: solid 1px $font;
1.721     harmsja  8408: }
1.795     www      8409: 
1.847     tempelho 8410: ul.LC_TabContent .right {
1.911     bisitz   8411:   float:right;
1.847     tempelho 8412: }
                   8413: 
1.911     bisitz   8414: ul.LC_TabContent li a,
                   8415: ul.LC_TabContent li {
                   8416:   color:rgb(47,47,47);
                   8417:   text-decoration:none;
                   8418:   font-size:95%;
                   8419:   font-weight:bold;
1.952     onken    8420:   min-height:20px;
                   8421: }
                   8422: 
1.959     onken    8423: ul.LC_TabContent li a:hover,
                   8424: ul.LC_TabContent li a:focus {
1.952     onken    8425:   color: $button_hover;
1.959     onken    8426:   background:none;
                   8427:   outline:none;
1.952     onken    8428: }
                   8429: 
                   8430: ul.LC_TabContent li:hover {
                   8431:   color: $button_hover;
                   8432:   cursor:pointer;
1.721     harmsja  8433: }
1.795     www      8434: 
1.911     bisitz   8435: ul.LC_TabContent li.active {
1.952     onken    8436:   color: $font;
1.911     bisitz   8437:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    8438:   border-bottom:solid 1px #FFFFFF;
                   8439:   cursor: default;
1.744     ehlerst  8440: }
1.795     www      8441: 
1.959     onken    8442: ul.LC_TabContent li.active a {
                   8443:   color:$font;
                   8444:   background:#FFFFFF;
                   8445:   outline: none;
                   8446: }
1.1047    raeburn  8447: 
                   8448: ul.LC_TabContent li.goback {
                   8449:   float: left;
                   8450:   border-left: none;
                   8451: }
                   8452: 
1.870     tempelho 8453: #maincoursedoc {
1.911     bisitz   8454:   clear:both;
1.870     tempelho 8455: }
                   8456: 
                   8457: ul.LC_TabContentBigger {
1.911     bisitz   8458:   display:block;
                   8459:   list-style:none;
                   8460:   padding: 0;
1.870     tempelho 8461: }
                   8462: 
1.795     www      8463: ul.LC_TabContentBigger li {
1.911     bisitz   8464:   vertical-align:bottom;
                   8465:   height: 30px;
                   8466:   font-size:110%;
                   8467:   font-weight:bold;
                   8468:   color: #737373;
1.841     tempelho 8469: }
                   8470: 
1.957     onken    8471: ul.LC_TabContentBigger li.active {
                   8472:   position: relative;
                   8473:   top: 1px;
                   8474: }
                   8475: 
1.870     tempelho 8476: ul.LC_TabContentBigger li a {
1.911     bisitz   8477:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   8478:   height: 30px;
                   8479:   line-height: 30px;
                   8480:   text-align: center;
                   8481:   display: block;
                   8482:   text-decoration: none;
1.958     onken    8483:   outline: none;  
1.741     harmsja  8484: }
1.795     www      8485: 
1.870     tempelho 8486: ul.LC_TabContentBigger li.active a {
1.911     bisitz   8487:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   8488:   color:$font;
1.744     ehlerst  8489: }
1.795     www      8490: 
1.870     tempelho 8491: ul.LC_TabContentBigger li b {
1.911     bisitz   8492:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   8493:   display: block;
                   8494:   float: left;
                   8495:   padding: 0 30px;
1.957     onken    8496:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 8497: }
                   8498: 
1.956     onken    8499: ul.LC_TabContentBigger li:hover b {
                   8500:   color:$button_hover;
                   8501: }
                   8502: 
1.870     tempelho 8503: ul.LC_TabContentBigger li.active b {
1.911     bisitz   8504:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   8505:   color:$font;
1.957     onken    8506:   border: 0;
1.741     harmsja  8507: }
1.693     droeschl 8508: 
1.870     tempelho 8509: 
1.862     bisitz   8510: ul.LC_CourseBreadcrumbs {
                   8511:   background: $sidebg;
1.1020    raeburn  8512:   height: 2em;
1.862     bisitz   8513:   padding-left: 10px;
1.1020    raeburn  8514:   margin: 0;
1.862     bisitz   8515:   list-style-position: inside;
                   8516: }
                   8517: 
1.911     bisitz   8518: ol#LC_MenuBreadcrumbs,
1.862     bisitz   8519: ol#LC_PathBreadcrumbs {
1.911     bisitz   8520:   padding-left: 10px;
                   8521:   margin: 0;
1.933     droeschl 8522:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 8523: }
                   8524: 
1.911     bisitz   8525: ol#LC_MenuBreadcrumbs li,
                   8526: ol#LC_PathBreadcrumbs li,
1.862     bisitz   8527: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   8528:   display: inline;
1.933     droeschl 8529:   white-space: normal;  
1.693     droeschl 8530: }
                   8531: 
1.823     bisitz   8532: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   8533: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   8534:   text-decoration: none;
                   8535:   font-size:90%;
1.693     droeschl 8536: }
1.795     www      8537: 
1.969     droeschl 8538: ol#LC_MenuBreadcrumbs h1 {
                   8539:   display: inline;
                   8540:   font-size: 90%;
                   8541:   line-height: 2.5em;
                   8542:   margin: 0;
                   8543:   padding: 0;
                   8544: }
                   8545: 
1.795     www      8546: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   8547:   text-decoration:none;
                   8548:   font-size:100%;
                   8549:   font-weight:bold;
1.693     droeschl 8550: }
1.795     www      8551: 
1.840     bisitz   8552: .LC_Box {
1.911     bisitz   8553:   border: solid 1px $lg_border_color;
                   8554:   padding: 0 10px 10px 10px;
1.746     neumanie 8555: }
1.795     www      8556: 
1.1020    raeburn  8557: .LC_DocsBox {
                   8558:   border: solid 1px $lg_border_color;
                   8559:   padding: 0 0 10px 10px;
                   8560: }
                   8561: 
1.795     www      8562: .LC_AboutMe_Image {
1.911     bisitz   8563:   float:left;
                   8564:   margin-right:10px;
1.747     neumanie 8565: }
1.795     www      8566: 
                   8567: .LC_Clear_AboutMe_Image {
1.911     bisitz   8568:   clear:left;
1.747     neumanie 8569: }
1.795     www      8570: 
1.721     harmsja  8571: dl.LC_ListStyleClean dt {
1.911     bisitz   8572:   padding-right: 5px;
                   8573:   display: table-header-group;
1.693     droeschl 8574: }
                   8575: 
1.721     harmsja  8576: dl.LC_ListStyleClean dd {
1.911     bisitz   8577:   display: table-row;
1.693     droeschl 8578: }
                   8579: 
1.721     harmsja  8580: .LC_ListStyleClean,
                   8581: .LC_ListStyleSimple,
                   8582: .LC_ListStyleNormal,
1.795     www      8583: .LC_ListStyleSpecial {
1.911     bisitz   8584:   /* display:block; */
                   8585:   list-style-position: inside;
                   8586:   list-style-type: none;
                   8587:   overflow: hidden;
                   8588:   padding: 0;
1.693     droeschl 8589: }
                   8590: 
1.721     harmsja  8591: .LC_ListStyleSimple li,
                   8592: .LC_ListStyleSimple dd,
                   8593: .LC_ListStyleNormal li,
                   8594: .LC_ListStyleNormal dd,
                   8595: .LC_ListStyleSpecial li,
1.795     www      8596: .LC_ListStyleSpecial dd {
1.911     bisitz   8597:   margin: 0;
                   8598:   padding: 5px 5px 5px 10px;
                   8599:   clear: both;
1.693     droeschl 8600: }
                   8601: 
1.721     harmsja  8602: .LC_ListStyleClean li,
                   8603: .LC_ListStyleClean dd {
1.911     bisitz   8604:   padding-top: 0;
                   8605:   padding-bottom: 0;
1.693     droeschl 8606: }
                   8607: 
1.721     harmsja  8608: .LC_ListStyleSimple dd,
1.795     www      8609: .LC_ListStyleSimple li {
1.911     bisitz   8610:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 8611: }
                   8612: 
1.721     harmsja  8613: .LC_ListStyleSpecial li,
                   8614: .LC_ListStyleSpecial dd {
1.911     bisitz   8615:   list-style-type: none;
                   8616:   background-color: RGB(220, 220, 220);
                   8617:   margin-bottom: 4px;
1.693     droeschl 8618: }
                   8619: 
1.721     harmsja  8620: table.LC_SimpleTable {
1.911     bisitz   8621:   margin:5px;
                   8622:   border:solid 1px $lg_border_color;
1.795     www      8623: }
1.693     droeschl 8624: 
1.721     harmsja  8625: table.LC_SimpleTable tr {
1.911     bisitz   8626:   padding: 0;
                   8627:   border:solid 1px $lg_border_color;
1.693     droeschl 8628: }
1.795     www      8629: 
                   8630: table.LC_SimpleTable thead {
1.911     bisitz   8631:   background:rgb(220,220,220);
1.693     droeschl 8632: }
                   8633: 
1.721     harmsja  8634: div.LC_columnSection {
1.911     bisitz   8635:   display: block;
                   8636:   clear: both;
                   8637:   overflow: hidden;
                   8638:   margin: 0;
1.693     droeschl 8639: }
                   8640: 
1.721     harmsja  8641: div.LC_columnSection>* {
1.911     bisitz   8642:   float: left;
                   8643:   margin: 10px 20px 10px 0;
                   8644:   overflow:hidden;
1.693     droeschl 8645: }
1.721     harmsja  8646: 
1.795     www      8647: table em {
1.911     bisitz   8648:   font-weight: bold;
                   8649:   font-style: normal;
1.748     schulted 8650: }
1.795     www      8651: 
1.779     bisitz   8652: table.LC_tableBrowseRes,
1.795     www      8653: table.LC_tableOfContent {
1.911     bisitz   8654:   border:none;
                   8655:   border-spacing: 1px;
                   8656:   padding: 3px;
                   8657:   background-color: #FFFFFF;
                   8658:   font-size: 90%;
1.753     droeschl 8659: }
1.789     droeschl 8660: 
1.911     bisitz   8661: table.LC_tableOfContent {
                   8662:   border-collapse: collapse;
1.789     droeschl 8663: }
                   8664: 
1.771     droeschl 8665: table.LC_tableBrowseRes a,
1.768     schulted 8666: table.LC_tableOfContent a {
1.911     bisitz   8667:   background-color: transparent;
                   8668:   text-decoration: none;
1.753     droeschl 8669: }
                   8670: 
1.795     www      8671: table.LC_tableOfContent img {
1.911     bisitz   8672:   border: none;
                   8673:   height: 1.3em;
                   8674:   vertical-align: text-bottom;
                   8675:   margin-right: 0.3em;
1.753     droeschl 8676: }
1.757     schulted 8677: 
1.795     www      8678: a#LC_content_toolbar_firsthomework {
1.911     bisitz   8679:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  8680: }
                   8681: 
1.795     www      8682: a#LC_content_toolbar_everything {
1.911     bisitz   8683:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  8684: }
                   8685: 
1.795     www      8686: a#LC_content_toolbar_uncompleted {
1.911     bisitz   8687:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  8688: }
                   8689: 
1.795     www      8690: #LC_content_toolbar_clearbubbles {
1.911     bisitz   8691:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  8692: }
                   8693: 
1.795     www      8694: a#LC_content_toolbar_changefolder {
1.911     bisitz   8695:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 8696: }
                   8697: 
1.795     www      8698: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   8699:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 8700: }
                   8701: 
1.1043    raeburn  8702: a#LC_content_toolbar_edittoplevel {
                   8703:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   8704: }
                   8705: 
1.1384    raeburn  8706: a#LC_content_toolbar_printout {
                   8707:   background-image:url(/res/adm/pages/printout.gif);
                   8708: }
                   8709: 
1.795     www      8710: ul#LC_toolbar li a:hover {
1.911     bisitz   8711:   background-position: bottom center;
1.757     schulted 8712: }
                   8713: 
1.795     www      8714: ul#LC_toolbar {
1.911     bisitz   8715:   padding: 0;
                   8716:   margin: 2px;
                   8717:   list-style:none;
                   8718:   position:relative;
                   8719:   background-color:white;
1.1082    raeburn  8720:   overflow: auto;
1.757     schulted 8721: }
                   8722: 
1.795     www      8723: ul#LC_toolbar li {
1.911     bisitz   8724:   border:1px solid white;
                   8725:   padding: 0;
                   8726:   margin: 0;
                   8727:   float: left;
                   8728:   display:inline;
                   8729:   vertical-align:middle;
1.1082    raeburn  8730:   white-space: nowrap;
1.911     bisitz   8731: }
1.757     schulted 8732: 
1.783     amueller 8733: 
1.795     www      8734: a.LC_toolbarItem {
1.911     bisitz   8735:   display:block;
                   8736:   padding: 0;
                   8737:   margin: 0;
                   8738:   height: 32px;
                   8739:   width: 32px;
                   8740:   color:white;
                   8741:   border: none;
                   8742:   background-repeat:no-repeat;
                   8743:   background-color:transparent;
1.757     schulted 8744: }
                   8745: 
1.915     droeschl 8746: ul.LC_funclist {
                   8747:     margin: 0;
                   8748:     padding: 0.5em 1em 0.5em 0;
                   8749: }
                   8750: 
1.933     droeschl 8751: ul.LC_funclist > li:first-child {
                   8752:     font-weight:bold; 
                   8753:     margin-left:0.8em;
                   8754: }
                   8755: 
1.915     droeschl 8756: ul.LC_funclist + ul.LC_funclist {
                   8757:     /* 
                   8758:        left border as a seperator if we have more than
                   8759:        one list 
                   8760:     */
                   8761:     border-left: 1px solid $sidebg;
                   8762:     /* 
                   8763:        this hides the left border behind the border of the 
                   8764:        outer box if element is wrapped to the next 'line' 
                   8765:     */
                   8766:     margin-left: -1px;
                   8767: }
                   8768: 
1.843     bisitz   8769: ul.LC_funclist li {
1.915     droeschl 8770:   display: inline;
1.782     bisitz   8771:   white-space: nowrap;
1.915     droeschl 8772:   margin: 0 0 0 25px;
                   8773:   line-height: 150%;
1.782     bisitz   8774: }
                   8775: 
1.974     wenzelju 8776: .LC_hidden {
                   8777:   display: none;
                   8778: }
                   8779: 
1.1030    www      8780: .LCmodal-overlay {
                   8781: 		position:fixed;
                   8782: 		top:0;
                   8783: 		right:0;
                   8784: 		bottom:0;
                   8785: 		left:0;
                   8786: 		height:100%;
                   8787: 		width:100%;
                   8788: 		margin:0;
                   8789: 		padding:0;
                   8790: 		background:#999;
                   8791: 		opacity:.75;
                   8792: 		filter: alpha(opacity=75);
                   8793: 		-moz-opacity: 0.75;
                   8794: 		z-index:101;
                   8795: }
                   8796: 
                   8797: * html .LCmodal-overlay {   
                   8798: 		position: absolute;
                   8799: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   8800: }
                   8801: 
                   8802: .LCmodal-window {
                   8803: 		position:fixed;
                   8804: 		top:50%;
                   8805: 		left:50%;
                   8806: 		margin:0;
                   8807: 		padding:0;
                   8808: 		z-index:102;
                   8809: 	}
                   8810: 
                   8811: * html .LCmodal-window {
                   8812: 		position:absolute;
                   8813: }
                   8814: 
                   8815: .LCclose-window {
                   8816: 		position:absolute;
                   8817: 		width:32px;
                   8818: 		height:32px;
                   8819: 		right:8px;
                   8820: 		top:8px;
                   8821: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   8822: 		text-indent:-99999px;
                   8823: 		overflow:hidden;
                   8824: 		cursor:pointer;
                   8825: }
                   8826: 
1.1369    raeburn  8827: .LCisDisabled {
                   8828:   cursor: not-allowed;
                   8829:   opacity: 0.5;
                   8830: }
                   8831: 
                   8832: a[aria-disabled="true"] {
                   8833:   color: currentColor;
                   8834:   display: inline-block;  /* For IE11/ MS Edge bug */
                   8835:   pointer-events: none;
                   8836:   text-decoration: none;
                   8837: }
                   8838: 
1.1335    raeburn  8839: pre.LC_wordwrap {
                   8840:   white-space: pre-wrap;
                   8841:   white-space: -moz-pre-wrap;
                   8842:   white-space: -pre-wrap;
                   8843:   white-space: -o-pre-wrap;
                   8844:   word-wrap: break-word;
                   8845: }
                   8846: 
1.1100    raeburn  8847: /*
1.1231    damieng  8848:   styles used for response display
                   8849: */
                   8850: div.LC_radiofoil, div.LC_rankfoil {
                   8851:   margin: .5em 0em .5em 0em;
                   8852: }
                   8853: table.LC_itemgroup {
                   8854:   margin-top: 1em;
                   8855: }
                   8856: 
                   8857: /*
1.1100    raeburn  8858:   styles used by TTH when "Default set of options to pass to tth/m
                   8859:   when converting TeX" in course settings has been set
                   8860: 
                   8861:   option passed: -t
                   8862: 
                   8863: */
                   8864: 
                   8865: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   8866: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   8867: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   8868: td div.norm {line-height:normal;}
                   8869: 
                   8870: /*
                   8871:   option passed -y3
                   8872: */
                   8873: 
                   8874: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   8875: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   8876: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   8877: 
1.1230    damieng  8878: /*
                   8879:   sections with roles, for content only
                   8880: */
                   8881: section[class^="role-"] {
                   8882:   padding-left: 10px;
                   8883:   padding-right: 5px;
                   8884:   margin-top: 8px;
                   8885:   margin-bottom: 8px;
                   8886:   border: 1px solid #2A4;
                   8887:   border-radius: 5px;
                   8888:   box-shadow: 0px 1px 1px #BBB;
                   8889: }
                   8890: section[class^="role-"]>h1 {
                   8891:   position: relative;
                   8892:   margin: 0px;
                   8893:   padding-top: 10px;
                   8894:   padding-left: 40px;
                   8895: }
                   8896: section[class^="role-"]>h1:before {
                   8897:   position: absolute;
                   8898:   left: -5px;
                   8899:   top: 5px;
                   8900: }
                   8901: section.role-activity>h1:before {
                   8902:   content:url('/adm/daxe/images/section_icons/activity.png');
                   8903: }
                   8904: section.role-advice>h1:before {
                   8905:   content:url('/adm/daxe/images/section_icons/advice.png');
                   8906: }
                   8907: section.role-bibliography>h1:before {
                   8908:   content:url('/adm/daxe/images/section_icons/bibliography.png');
                   8909: }
                   8910: section.role-citation>h1:before {
                   8911:   content:url('/adm/daxe/images/section_icons/citation.png');
                   8912: }
                   8913: section.role-conclusion>h1:before {
                   8914:   content:url('/adm/daxe/images/section_icons/conclusion.png');
                   8915: }
                   8916: section.role-definition>h1:before {
                   8917:   content:url('/adm/daxe/images/section_icons/definition.png');
                   8918: }
                   8919: section.role-demonstration>h1:before {
                   8920:   content:url('/adm/daxe/images/section_icons/demonstration.png');
                   8921: }
                   8922: section.role-example>h1:before {
                   8923:   content:url('/adm/daxe/images/section_icons/example.png');
                   8924: }
                   8925: section.role-explanation>h1:before {
                   8926:   content:url('/adm/daxe/images/section_icons/explanation.png');
                   8927: }
                   8928: section.role-introduction>h1:before {
                   8929:   content:url('/adm/daxe/images/section_icons/introduction.png');
                   8930: }
                   8931: section.role-method>h1:before {
                   8932:   content:url('/adm/daxe/images/section_icons/method.png');
                   8933: }
                   8934: section.role-more_information>h1:before {
                   8935:   content:url('/adm/daxe/images/section_icons/more_information.png');
                   8936: }
                   8937: section.role-objectives>h1:before {
                   8938:   content:url('/adm/daxe/images/section_icons/objectives.png');
                   8939: }
                   8940: section.role-prerequisites>h1:before {
                   8941:   content:url('/adm/daxe/images/section_icons/prerequisites.png');
                   8942: }
                   8943: section.role-remark>h1:before {
                   8944:   content:url('/adm/daxe/images/section_icons/remark.png');
                   8945: }
                   8946: section.role-reminder>h1:before {
                   8947:   content:url('/adm/daxe/images/section_icons/reminder.png');
                   8948: }
                   8949: section.role-summary>h1:before {
                   8950:   content:url('/adm/daxe/images/section_icons/summary.png');
                   8951: }
                   8952: section.role-syntax>h1:before {
                   8953:   content:url('/adm/daxe/images/section_icons/syntax.png');
                   8954: }
                   8955: section.role-warning>h1:before {
                   8956:   content:url('/adm/daxe/images/section_icons/warning.png');
                   8957: }
                   8958: 
1.1269    raeburn  8959: #LC_minitab_header {
                   8960:   float:left;
                   8961:   width:100%;
                   8962:   background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
                   8963:   font-size:93%;
                   8964:   line-height:normal;
                   8965:   margin: 0.5em 0 0.5em 0;
                   8966: }
                   8967: #LC_minitab_header ul {
                   8968:   margin:0;
                   8969:   padding:10px 10px 0;
                   8970:   list-style:none;
                   8971: }
                   8972: #LC_minitab_header li {
                   8973:   float:left;
                   8974:   background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
                   8975:   margin:0;
                   8976:   padding:0 0 0 9px;
                   8977: }
                   8978: #LC_minitab_header a {
                   8979:   display:block;
                   8980:   background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
                   8981:   padding:5px 15px 4px 6px;
                   8982: }
                   8983: #LC_minitab_header #LC_current_minitab {
                   8984:   background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
                   8985: }
                   8986: #LC_minitab_header #LC_current_minitab a {
                   8987:   background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
                   8988:   padding-bottom:5px;
                   8989: }
                   8990: 
                   8991: 
1.343     albertel 8992: END
                   8993: }
                   8994: 
1.306     albertel 8995: =pod
                   8996: 
                   8997: =item * &headtag()
                   8998: 
                   8999: Returns a uniform footer for LON-CAPA web pages.
                   9000: 
1.307     albertel 9001: Inputs: $title - optional title for the head
                   9002:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 9003:         $args - optional arguments
1.319     albertel 9004:             force_register - if is true call registerurl so the remote is 
                   9005:                              informed
1.415     albertel 9006:             redirect       -> array ref of
                   9007:                                    1- seconds before redirect occurs
                   9008:                                    2- url to redirect to
                   9009:                                    3- whether the side effect should occur
1.315     albertel 9010:                            (side effect of setting 
                   9011:                                $env{'internal.head.redirect'} to the url 
1.1386    raeburn  9012:                                redirected to)
                   9013:                                    4- whether the redirect target should be
                   9014:                                       the opener of the current (pop-up)
                   9015:                                       window (side effect of setting
                   9016:                                       $env{'internal.head.to_opener'} to
                   9017:                                       1, if true.
1.1388    raeburn  9018:                                    5- whether encrypt check should be skipped
1.352     albertel 9019:             domain         -> force to color decorate a page for a specific
                   9020:                                domain
                   9021:             function       -> force usage of a specific rolish color scheme
                   9022:             bgcolor        -> override the default page bgcolor
1.460     albertel 9023:             no_auto_mt_title
                   9024:                            -> prevent &mt()ing the title arg
1.464     albertel 9025: 
1.306     albertel 9026: =cut
                   9027: 
                   9028: sub headtag {
1.313     albertel 9029:     my ($title,$head_extra,$args) = @_;
1.306     albertel 9030:     
1.363     albertel 9031:     my $function = $args->{'function'} || &get_users_function();
                   9032:     my $domain   = $args->{'domain'}   || &determinedomain();
                   9033:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  9034:     my $httphost = $args->{'use_absolute'};
1.418     albertel 9035:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 9036: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 9037: 		   #time(),
1.418     albertel 9038: 		   $env{'environment.color.timestamp'},
1.363     albertel 9039: 		   $function,$domain,$bgcolor);
                   9040: 
1.369     www      9041:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 9042: 
1.308     albertel 9043:     my $result =
                   9044: 	'<head>'.
1.1160    raeburn  9045: 	&font_settings($args);
1.319     albertel 9046: 
1.1188    raeburn  9047:     my $inhibitprint;
                   9048:     if ($args->{'print_suppress'}) {
                   9049:         $inhibitprint = &print_suppression();
                   9050:     }
1.1064    raeburn  9051: 
1.461     albertel 9052:     if (!$args->{'frameset'}) {
                   9053: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   9054:     }
1.962     droeschl 9055:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   9056:         $result .= Apache::lonxml::display_title();
1.319     albertel 9057:     }
1.436     albertel 9058:     if (!$args->{'no_nav_bar'} 
                   9059: 	&& !$args->{'only_body'}
                   9060: 	&& !$args->{'frameset'}) {
1.1154    raeburn  9061: 	$result .= &help_menu_js($httphost);
1.1032    www      9062:         $result.=&modal_window();
1.1038    www      9063:         $result.=&togglebox_script();
1.1034    www      9064:         $result.=&wishlist_window();
1.1041    www      9065:         $result.=&LCprogressbarUpdate_script();
1.1034    www      9066:     } else {
                   9067:         if ($args->{'add_modal'}) {
                   9068:            $result.=&modal_window();
                   9069:         }
                   9070:         if ($args->{'add_wishlist'}) {
                   9071:            $result.=&wishlist_window();
                   9072:         }
1.1038    www      9073:         if ($args->{'add_togglebox'}) {
                   9074:            $result.=&togglebox_script();
                   9075:         }
1.1041    www      9076:         if ($args->{'add_progressbar'}) {
                   9077:            $result.=&LCprogressbarUpdate_script();
                   9078:         }
1.436     albertel 9079:     }
1.314     albertel 9080:     if (ref($args->{'redirect'})) {
1.1388    raeburn  9081: 	my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
                   9082:         if (!$skip_enc_check) {
                   9083:             $url = &Apache::lonenc::check_encrypt($url);
                   9084:         }
1.414     albertel 9085: 	if (!$inhibit_continue) {
                   9086: 	    $env{'internal.head.redirect'} = $url;
                   9087: 	}
1.1386    raeburn  9088: 	$result.=<<"ADDMETA";
1.313     albertel 9089: <meta http-equiv="pragma" content="no-cache" />
1.1386    raeburn  9090: ADDMETA
                   9091:         if ($to_opener) {
                   9092:             $env{'internal.head.to_opener'} = 1;
                   9093:             my $dest = &js_escape($url);
                   9094:             my $timeout = int($time * 1000);
                   9095:             $result .=<<"ENDJS";
                   9096: <script type="text/javascript">
                   9097: // <![CDATA[
                   9098: function LC_To_Opener() {
                   9099:     var dest = '$dest';
                   9100:     if (dest != '') {
                   9101:         if (window.opener != null && !window.opener.closed) {
                   9102:             window.opener.location.href=dest;
                   9103:             window.close();
                   9104:         } else {
                   9105:             window.location.href=dest;
                   9106:         }
                   9107:     }
                   9108: }
                   9109: \$(document).ready(function () {
                   9110:     setTimeout('LC_To_Opener()',$timeout);
                   9111: });
                   9112: // ]]>
                   9113: </script>
                   9114: ENDJS
                   9115:         } else {
                   9116:             $result.=<<"ADDMETA";
1.344     albertel 9117: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 9118: ADDMETA
1.1386    raeburn  9119:         }
1.1210    raeburn  9120:     } else {
                   9121:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   9122:             my $requrl = $env{'request.uri'};
                   9123:             if ($requrl eq '') {
                   9124:                 $requrl = $ENV{'REQUEST_URI'};
                   9125:                 $requrl =~ s/\?.+$//;
                   9126:             }
                   9127:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   9128:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   9129:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   9130:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   9131:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   9132:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340    raeburn  9133:                     my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352    raeburn  9134:                     my ($offload,$offloadoth);
1.1210    raeburn  9135:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   9136:                         if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340    raeburn  9137:                             $offload = 1;
1.1353    raeburn  9138:                             if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   9139:                                 (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   9140:                                 unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   9141:                                     $offloadoth = 1;
                   9142:                                     $dom_in_use = $env{'user.domain'};
                   9143:                                 }
                   9144:                             }
1.1340    raeburn  9145:                         }
                   9146:                     }
                   9147:                     unless ($offload) {
                   9148:                         if (ref($domdefs{'offloadoth'}) eq 'HASH') {
                   9149:                             if ($domdefs{'offloadoth'}{$lonhost}) {
                   9150:                                 if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   9151:                                     (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   9152:                                     unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   9153:                                         $offload = 1;
1.1352    raeburn  9154:                                         $offloadoth = 1;
1.1340    raeburn  9155:                                         $dom_in_use = $env{'user.domain'};
                   9156:                                     }
1.1210    raeburn  9157:                                 }
1.1340    raeburn  9158:                             }
                   9159:                         }
                   9160:                     }
                   9161:                     if ($offload) {
1.1358    raeburn  9162:                         my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352    raeburn  9163:                         if (($newserver eq '') && ($offloadoth)) {
                   9164:                             my @domains = &Apache::lonnet::current_machine_domains();
                   9165:                             if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
                   9166:                                 ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                   9167:                             }
                   9168:                         }
1.1340    raeburn  9169:                         if (($newserver) && ($newserver ne $lonhost)) {
                   9170:                             my $numsec = 5;
                   9171:                             my $timeout = $numsec * 1000;
                   9172:                             my ($newurl,$locknum,%locks,$msg);
                   9173:                             if ($env{'request.role.adv'}) {
                   9174:                                 ($locknum,%locks) = &Apache::lonnet::get_locks();
                   9175:                             }
                   9176:                             my $disable_submit = 0;
                   9177:                             if ($requrl =~ /$LONCAPA::assess_re/) {
                   9178:                                 $disable_submit = 1;
                   9179:                             }
                   9180:                             if ($locknum) {
                   9181:                                 my @lockinfo = sort(values(%locks));
1.1354    raeburn  9182:                                 $msg = &mt('Once the following tasks are complete:')." \n".
1.1340    raeburn  9183:                                        join(", ",sort(values(%locks)))."\n";
                   9184:                                 if (&show_course()) {
                   9185:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
                   9186:                                 } else {
                   9187:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210    raeburn  9188:                                 }
1.1340    raeburn  9189:                             } else {
                   9190:                                 if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   9191:                                     $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
                   9192:                                 }
                   9193:                                 $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   9194:                                 $newurl = '/adm/switchserver?otherserver='.$newserver;
                   9195:                                 if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   9196:                                     $newurl .= '&role='.$env{'request.role'};
                   9197:                                 }
                   9198:                                 if ($env{'request.symb'}) {
                   9199:                                     my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
                   9200:                                     if ($shownsymb =~ m{^/enc/}) {
                   9201:                                         my $reqdmajor = 2;
                   9202:                                         my $reqdminor = 11;
                   9203:                                         my $reqdsubminor = 3;
                   9204:                                         my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
                   9205:                                         my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
                   9206:                                         my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
                   9207:                                         if (($major eq '' && $minor eq '') ||
                   9208:                                             (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
                   9209:                                             (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
                   9210:                                              ($reqdsubminor > $subminor))))) {
                   9211:                                             undef($shownsymb);
                   9212:                                         }
1.1210    raeburn  9213:                                     }
1.1340    raeburn  9214:                                     if ($shownsymb) {
                   9215:                                         &js_escape(\$shownsymb);
                   9216:                                         $newurl .= '&symb='.$shownsymb;
1.1210    raeburn  9217:                                     }
1.1340    raeburn  9218:                                 } else {
                   9219:                                     my $shownurl = &Apache::lonenc::check_encrypt($requrl);
                   9220:                                     &js_escape(\$shownurl);
                   9221:                                     $newurl .= '&origurl='.$shownurl;
1.1210    raeburn  9222:                                 }
1.1340    raeburn  9223:                             }
                   9224:                             &js_escape(\$msg);
                   9225:                             $result.=<<OFFLOAD
1.1210    raeburn  9226: <meta http-equiv="pragma" content="no-cache" />
                   9227: <script type="text/javascript">
1.1215    raeburn  9228: // <![CDATA[
1.1210    raeburn  9229: function LC_Offload_Now() {
                   9230:     var dest = "$newurl";
                   9231:     if (dest != '') {
                   9232:         window.location.href="$newurl";
                   9233:     }
                   9234: }
1.1214    raeburn  9235: \$(document).ready(function () {
                   9236:     window.alert('$msg');
                   9237:     if ($disable_submit) {
1.1210    raeburn  9238:         \$(".LC_hwk_submit").prop("disabled", true);
                   9239:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214    raeburn  9240:     }
                   9241:     setTimeout('LC_Offload_Now()', $timeout);
                   9242: });
1.1215    raeburn  9243: // ]]>
1.1210    raeburn  9244: </script>
                   9245: OFFLOAD
                   9246:                         }
                   9247:                     }
                   9248:                 }
                   9249:             }
                   9250:         }
1.313     albertel 9251:     }
1.306     albertel 9252:     if (!defined($title)) {
                   9253: 	$title = 'The LearningOnline Network with CAPA';
                   9254:     }
1.460     albertel 9255:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   9256:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  9257: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   9258:     if (!$args->{'frameset'}) {
                   9259:         $result .= ' /';
                   9260:     }
                   9261:     $result .= '>' 
1.1064    raeburn  9262:         .$inhibitprint
1.414     albertel 9263: 	.$head_extra;
1.1242    raeburn  9264:     my $clientmobile;
                   9265:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   9266:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   9267:     } else {
                   9268:         $clientmobile = $env{'browser.mobile'};
                   9269:     }
                   9270:     if ($clientmobile) {
1.1137    raeburn  9271:         $result .= '
                   9272: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   9273: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   9274:     }
1.1278    raeburn  9275:     $result .= '<meta name="google" content="notranslate" />'."\n";
1.962     droeschl 9276:     return $result.'</head>';
1.306     albertel 9277: }
                   9278: 
                   9279: =pod
                   9280: 
1.340     albertel 9281: =item * &font_settings()
                   9282: 
                   9283: Returns neccessary <meta> to set the proper encoding
                   9284: 
1.1160    raeburn  9285: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 9286: 
                   9287: =cut
                   9288: 
                   9289: sub font_settings {
1.1160    raeburn  9290:     my ($args) = @_;
1.340     albertel 9291:     my $headerstring='';
1.1160    raeburn  9292:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   9293:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  9294:         $headerstring.=
                   9295:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   9296:         if (!$args->{'frameset'}) {
                   9297: 	    $headerstring.= ' /';
                   9298:         }
                   9299: 	$headerstring .= '>'."\n";
1.340     albertel 9300:     }
                   9301:     return $headerstring;
                   9302: }
                   9303: 
1.341     albertel 9304: =pod
                   9305: 
1.1064    raeburn  9306: =item * &print_suppression()
                   9307: 
                   9308: In course context returns css which causes the body to be blank when media="print",
                   9309: if printout generation is unavailable for the current resource.
                   9310: 
                   9311: This could be because:
                   9312: 
                   9313: (a) printstartdate is in the future
                   9314: 
                   9315: (b) printenddate is in the past
                   9316: 
                   9317: (c) there is an active exam block with "printout"
                   9318: functionality blocked
                   9319: 
                   9320: Users with pav, pfo or evb privileges are exempt.
                   9321: 
                   9322: Inputs: none
                   9323: 
                   9324: =cut
                   9325: 
                   9326: 
                   9327: sub print_suppression {
                   9328:     my $noprint;
                   9329:     if ($env{'request.course.id'}) {
                   9330:         my $scope = $env{'request.course.id'};
                   9331:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   9332:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   9333:             return;
                   9334:         }
                   9335:         if ($env{'request.course.sec'} ne '') {
                   9336:             $scope .= "/$env{'request.course.sec'}";
                   9337:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   9338:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  9339:                 return;
1.1064    raeburn  9340:             }
                   9341:         }
                   9342:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9343:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372    raeburn  9344:         my $clientip = &Apache::lonnet::get_requestor_ip();
                   9345:         my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064    raeburn  9346:         if ($blocked) {
                   9347:             my $checkrole = "cm./$cdom/$cnum";
                   9348:             if ($env{'request.course.sec'} ne '') {
                   9349:                 $checkrole .= "/$env{'request.course.sec'}";
                   9350:             }
                   9351:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   9352:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   9353:                 $noprint = 1;
                   9354:             }
                   9355:         }
                   9356:         unless ($noprint) {
                   9357:             my $symb = &Apache::lonnet::symbread();
                   9358:             if ($symb ne '') {
                   9359:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   9360:                 if (ref($navmap)) {
                   9361:                     my $res = $navmap->getBySymb($symb);
                   9362:                     if (ref($res)) {
                   9363:                         if (!$res->resprintable()) {
                   9364:                             $noprint = 1;
                   9365:                         }
                   9366:                     }
                   9367:                 }
                   9368:             }
                   9369:         }
                   9370:         if ($noprint) {
                   9371:             return <<"ENDSTYLE";
                   9372: <style type="text/css" media="print">
                   9373:     body { display:none }
                   9374: </style>
                   9375: ENDSTYLE
                   9376:         }
                   9377:     }
                   9378:     return;
                   9379: }
                   9380: 
                   9381: =pod
                   9382: 
1.341     albertel 9383: =item * &xml_begin()
                   9384: 
                   9385: Returns the needed doctype and <html>
                   9386: 
                   9387: Inputs: none
                   9388: 
                   9389: =cut
                   9390: 
                   9391: sub xml_begin {
1.1168    raeburn  9392:     my ($is_frameset) = @_;
1.341     albertel 9393:     my $output='';
                   9394: 
                   9395:     if ($env{'browser.mathml'}) {
                   9396: 	$output='<?xml version="1.0"?>'
                   9397:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   9398: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   9399:             
                   9400: #	    .'<!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">] >'
                   9401: 	    .'<!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">'
                   9402:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   9403: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  9404:     } elsif ($is_frameset) {
                   9405:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   9406:                 '<html>'."\n";
1.341     albertel 9407:     } else {
1.1168    raeburn  9408: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   9409:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 9410:     }
                   9411:     return $output;
                   9412: }
1.340     albertel 9413: 
                   9414: =pod
                   9415: 
1.306     albertel 9416: =item * &start_page()
                   9417: 
                   9418: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   9419: 
1.648     raeburn  9420: Inputs:
                   9421: 
                   9422: =over 4
                   9423: 
                   9424: $title - optional title for the page
                   9425: 
                   9426: $head_extra - optional extra HTML to incude inside the <head>
                   9427: 
                   9428: $args - additional optional args supported are:
                   9429: 
                   9430: =over 8
                   9431: 
                   9432:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 9433:                                     arg on
1.814     bisitz   9434:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  9435:              add_entries    -> additional attributes to add to the  <body>
                   9436:              domain         -> force to color decorate a page for a 
1.317     albertel 9437:                                     specific domain
1.648     raeburn  9438:              function       -> force usage of a specific rolish color
1.317     albertel 9439:                                     scheme
1.648     raeburn  9440:              redirect       -> see &headtag()
                   9441:              bgcolor        -> override the default page bg color
                   9442:              js_ready       -> return a string ready for being used in 
1.317     albertel 9443:                                     a javascript writeln
1.648     raeburn  9444:              html_encode    -> return a string ready for being used in 
1.320     albertel 9445:                                     a html attribute
1.648     raeburn  9446:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 9447:                                     $forcereg arg
1.648     raeburn  9448:              frameset       -> if true will start with a <frameset>
1.330     albertel 9449:                                     rather than <body>
1.648     raeburn  9450:              skip_phases    -> hash ref of 
1.338     albertel 9451:                                     head -> skip the <html><head> generation
                   9452:                                     body -> skip all <body> generation
1.648     raeburn  9453:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 9454:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  9455:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1272    raeburn  9456:              bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                   9457:                                     to lonhtmlcommon::breadcrumbs
1.1096    raeburn  9458:              group          -> includes the current group, if page is for a 
1.1274    raeburn  9459:                                specific group
                   9460:              use_absolute   -> for request for external resource or syllabus, this
                   9461:                                will contain https://<hostname> if server uses
                   9462:                                https (as per hosts.tab), but request is for http
                   9463:              hostname       -> hostname, originally from $r->hostname(), (optional).
1.1369    raeburn  9464:              links_disabled -> Links in primary and secondary menus are disabled
                   9465:                                (Can enable them once page has loaded - see lonroles.pm
                   9466:                                for an example).
1.1380    raeburn  9467:              links_target   -> Target for links, e.g., _parent (optional).
1.361     albertel 9468: 
1.648     raeburn  9469: =back
1.460     albertel 9470: 
1.648     raeburn  9471: =back
1.562     albertel 9472: 
1.306     albertel 9473: =cut
                   9474: 
                   9475: sub start_page {
1.309     albertel 9476:     my ($title,$head_extra,$args) = @_;
1.318     albertel 9477:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 9478: 
1.315     albertel 9479:     $env{'internal.start_page'}++;
1.1359    raeburn  9480:     my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964     droeschl 9481: 
1.338     albertel 9482:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  9483:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 9484:     }
1.1316    raeburn  9485: 
                   9486:     if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318    raeburn  9487:         if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
                   9488:             unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
                   9489:                 $args->{'no_primary_menu'} = 1;
                   9490:             }
                   9491:             unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
                   9492:                 $args->{'no_inline_menu'} = 1;
                   9493:             }
                   9494:             if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
                   9495:                 map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
                   9496:             }
                   9497:         } else {
                   9498:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9499:             my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
                   9500:             if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
                   9501:                 unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
                   9502:                     $args->{'no_primary_menu'} = 1;
                   9503:                 }
                   9504:                 unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
                   9505:                     $args->{'no_inline_menu'} = 1;
                   9506:                 }
                   9507:                 if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
                   9508:                     map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
                   9509:                 }
                   9510:             }
                   9511:         }
1.1316    raeburn  9512:         ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
                   9513:                                   $env{'course.'.$env{'request.course.id'}.'.domain'},
                   9514:                                   $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359    raeburn  9515:     } elsif ($env{'request.course.id'}) {
                   9516:         my $expiretime=600;
                   9517:         if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
                   9518:             &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
                   9519:         }
                   9520:         my ($deeplinkmenu,$menuref);
                   9521:         ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
                   9522:         if ($menucoll) {
                   9523:             if (ref($menuref) eq 'HASH') {
                   9524:                 %menu = %{$menuref};
                   9525:             }
                   9526:             if ($menu{'top'} eq 'n') {
                   9527:                 $args->{'no_primary_menu'} = 1;
                   9528:             }
                   9529:             if ($menu{'inline'} eq 'n') {
                   9530:                 unless (&Apache::lonnet::allowed('opa')) {
                   9531:                     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9532:                     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9533:                     my $crstype = &course_type();
                   9534:                     my $now = time;
                   9535:                     my $ccrole;
                   9536:                     if ($crstype eq 'Community') {
                   9537:                         $ccrole = 'co';
                   9538:                     } else {
                   9539:                         $ccrole = 'cc';
                   9540:                     }
                   9541:                     if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
                   9542:                         my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
                   9543:                         if ((($start) && ($start<0)) ||
                   9544:                             (($end) && ($end<$now))  ||
                   9545:                             (($start) && ($now<$start))) {
                   9546:                             $args->{'no_inline_menu'} = 1;
                   9547:                         }
                   9548:                     } else {
                   9549:                         $args->{'no_inline_menu'} = 1;
                   9550:                     }
                   9551:                 }
                   9552:             }
                   9553:         }
1.1316    raeburn  9554:     }
1.1359    raeburn  9555: 
1.1385    raeburn  9556:     my $showncrumbs;
1.338     albertel 9557:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   9558: 	if ($args->{'frameset'}) {
                   9559: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   9560: 						$args->{'add_entries'});
                   9561: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   9562:         } else {
                   9563:             $result .=
                   9564:                 &bodytag($title, 
                   9565:                          $args->{'function'},       $args->{'add_entries'},
                   9566:                          $args->{'only_body'},      $args->{'domain'},
                   9567:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  9568:                          $args->{'bgcolor'},        $args,
1.1385    raeburn  9569:                          \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,
                   9570:                          \%menu,\$showncrumbs);
1.831     bisitz   9571:         }
1.330     albertel 9572:     }
1.338     albertel 9573: 
1.315     albertel 9574:     if ($args->{'js_ready'}) {
1.713     kaisler  9575: 		$result = &js_ready($result);
1.315     albertel 9576:     }
1.320     albertel 9577:     if ($args->{'html_encode'}) {
1.713     kaisler  9578: 		$result = &html_encode($result);
                   9579:     }
                   9580: 
1.813     bisitz   9581:     # Preparation for new and consistent functionlist at top of screen
                   9582:     # if ($args->{'functionlist'}) {
                   9583:     #            $result .= &build_functionlist();
                   9584:     #}
                   9585: 
1.964     droeschl 9586:     # Don't add anything more if only_body wanted or in const space
                   9587:     return $result if    $args->{'only_body'} 
                   9588:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   9589: 
                   9590:     #Breadcrumbs
1.758     kaisler  9591:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1385    raeburn  9592:         unless ($showncrumbs) {
1.758     kaisler  9593: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   9594: 		#if any br links exists, add them to the breadcrumbs
                   9595: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   9596: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   9597: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   9598: 			}
                   9599: 		}
1.1096    raeburn  9600:                 # if @advtools array contains items add then to the breadcrumbs
                   9601:                 if (@advtools > 0) {
                   9602:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   9603:                 }
1.1272    raeburn  9604:                 my $menulink;
                   9605:                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                   9606:                 if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312    raeburn  9607:                      ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272    raeburn  9608:                      ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                   9609:                      ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                   9610:                      (!$env{'request.role.adv'}))) {
                   9611:                     $menulink = 0;
                   9612:                 } else {
                   9613:                     undef($menulink);
                   9614:                 }
1.1385    raeburn  9615:                 my $linkprotout;
                   9616:                 if ($env{'request.deeplink.login'}) {
                   9617:                     my $linkprotout = &Apache::lonmenu::linkprot_exit();
                   9618:                     if ($linkprotout) {
                   9619:                         &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
                   9620:                     }
                   9621:                 }
1.758     kaisler  9622: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   9623: 		if(exists($args->{'bread_crumbs_component'})){
1.1272    raeburn  9624: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237    raeburn  9625:                 } else {
1.1272    raeburn  9626: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758     kaisler  9627: 		}
1.1385    raeburn  9628:         }
1.320     albertel 9629:     }
1.315     albertel 9630:     return $result;
1.306     albertel 9631: }
                   9632: 
                   9633: sub end_page {
1.315     albertel 9634:     my ($args) = @_;
                   9635:     $env{'internal.end_page'}++;
1.330     albertel 9636:     my $result;
1.335     albertel 9637:     if ($args->{'discussion'}) {
                   9638: 	my ($target,$parser);
                   9639: 	if (ref($args->{'discussion'})) {
                   9640: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   9641: 				$args->{'discussion'}{'parser'});
                   9642: 	}
                   9643: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   9644:     }
1.330     albertel 9645:     if ($args->{'frameset'}) {
                   9646: 	$result .= '</frameset>';
                   9647:     } else {
1.635     raeburn  9648: 	$result .= &endbodytag($args);
1.330     albertel 9649:     }
1.1080    raeburn  9650:     unless ($args->{'notbody'}) {
                   9651:         $result .= "\n</html>";
                   9652:     }
1.330     albertel 9653: 
1.315     albertel 9654:     if ($args->{'js_ready'}) {
1.317     albertel 9655: 	$result = &js_ready($result);
1.315     albertel 9656:     }
1.335     albertel 9657: 
1.320     albertel 9658:     if ($args->{'html_encode'}) {
                   9659: 	$result = &html_encode($result);
                   9660:     }
1.335     albertel 9661: 
1.315     albertel 9662:     return $result;
                   9663: }
                   9664: 
1.1359    raeburn  9665: sub menucoll_in_effect {
                   9666:     my ($menucoll,$deeplinkmenu,%menu);
                   9667:     if ($env{'request.course.id'}) {
                   9668:         $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362    raeburn  9669:         if ($env{'request.deeplink.login'}) {
1.1370    raeburn  9670:             my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362    raeburn  9671:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9672:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9673:             if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
                   9674:                 if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
                   9675:                     my $navmap = Apache::lonnavmaps::navmap->new();
                   9676:                     if (ref($navmap)) {
                   9677:                         $deeplink = $navmap->get_mapparam(undef,
                   9678:                                                           &Apache::lonnet::declutter($env{'request.noversionuri'}),
                   9679:                                                           '0.deeplink');
1.1370    raeburn  9680:                     } else {
                   9681:                         $check_login_symb = 1;
1.1362    raeburn  9682:                     }
                   9683:                 } else {
1.1370    raeburn  9684:                     my $symb = &Apache::lonnet::symbread();
                   9685:                     if ($symb) {
                   9686:                         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
                   9687:                     } else {
                   9688:                         $check_login_symb = 1;
                   9689:                     }
1.1362    raeburn  9690:                 }
                   9691:             } else {
1.1370    raeburn  9692:                 $check_login_symb = 1;
                   9693:             }
                   9694:             if ($check_login_symb) {
1.1362    raeburn  9695:                 $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
                   9696:                 if ($deeplink_symb =~ /\.(page|sequence)$/) {
                   9697:                     my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
                   9698:                     my $navmap = Apache::lonnavmaps::navmap->new();
                   9699:                     if (ref($navmap)) {
                   9700:                         $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
                   9701:                     }
                   9702:                 } else {
                   9703:                     $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
                   9704:                 }
                   9705:             }
1.1359    raeburn  9706:             if ($deeplink ne '') {
1.1378    raeburn  9707:                 my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359    raeburn  9708:                 if ($display =~ /^\d+$/) {
                   9709:                     $deeplinkmenu = 1;
                   9710:                     $menucoll = $display;
                   9711:                 }
                   9712:             }
                   9713:         }
                   9714:         if ($menucoll) {
                   9715:             %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
                   9716:         }
                   9717:     }
                   9718:     return ($menucoll,$deeplinkmenu,\%menu);
                   9719: }
                   9720: 
1.1362    raeburn  9721: sub deeplink_login_symb {
                   9722:     my ($cnum,$cdom) = @_;
                   9723:     my $login_symb;
                   9724:     if ($env{'request.deeplink.login'}) {
1.1364    raeburn  9725:         $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
                   9726:     }
                   9727:     return $login_symb;
                   9728: }
                   9729: 
                   9730: sub symb_from_tinyurl {
                   9731:     my ($url,$cnum,$cdom) = @_;
                   9732:     if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
                   9733:         my $key = $1;
                   9734:         my ($tinyurl,$login);
                   9735:         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
                   9736:         if (defined($cached)) {
                   9737:             $tinyurl = $result;
                   9738:         } else {
                   9739:             my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                   9740:             my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
                   9741:             if ($currtiny{$key} ne '') {
                   9742:                 $tinyurl = $currtiny{$key};
                   9743:                 &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362    raeburn  9744:             }
1.1364    raeburn  9745:         }
                   9746:         if ($tinyurl ne '') {
                   9747:             my ($cnumreq,$symb) = split(/\&/,$tinyurl);
                   9748:             if (wantarray) {
                   9749:                 return ($cnumreq,$symb);
                   9750:             } elsif ($cnumreq eq $cnum) {
                   9751:                 return $symb;
1.1362    raeburn  9752:             }
                   9753:         }
                   9754:     }
1.1364    raeburn  9755:     if (wantarray) {
                   9756:         return ();
                   9757:     } else {
                   9758:         return;
                   9759:     }
1.1362    raeburn  9760: }
                   9761: 
1.1034    www      9762: sub wishlist_window {
                   9763:     return(<<'ENDWISHLIST');
1.1046    raeburn  9764: <script type="text/javascript">
1.1034    www      9765: // <![CDATA[
                   9766: // <!-- BEGIN LON-CAPA Internal
                   9767: function set_wishlistlink(title, path) {
                   9768:     if (!title) {
                   9769:         title = document.title;
                   9770:         title = title.replace(/^LON-CAPA /,'');
                   9771:     }
1.1175    raeburn  9772:     title = encodeURIComponent(title);
1.1203    raeburn  9773:     title = title.replace("'","\\\'");
1.1034    www      9774:     if (!path) {
                   9775:         path = location.pathname;
                   9776:     }
1.1175    raeburn  9777:     path = encodeURIComponent(path);
1.1203    raeburn  9778:     path = path.replace("'","\\\'");
1.1034    www      9779:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   9780:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   9781: }
                   9782: // END LON-CAPA Internal -->
                   9783: // ]]>
                   9784: </script>
                   9785: ENDWISHLIST
                   9786: }
                   9787: 
1.1030    www      9788: sub modal_window {
                   9789:     return(<<'ENDMODAL');
1.1046    raeburn  9790: <script type="text/javascript">
1.1030    www      9791: // <![CDATA[
                   9792: // <!-- BEGIN LON-CAPA Internal
                   9793: var modalWindow = {
                   9794: 	parent:"body",
                   9795: 	windowId:null,
                   9796: 	content:null,
                   9797: 	width:null,
                   9798: 	height:null,
                   9799: 	close:function()
                   9800: 	{
                   9801: 	        $(".LCmodal-window").remove();
                   9802: 	        $(".LCmodal-overlay").remove();
                   9803: 	},
                   9804: 	open:function()
                   9805: 	{
                   9806: 		var modal = "";
                   9807: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   9808: 		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;\">";
                   9809: 		modal += this.content;
                   9810: 		modal += "</div>";	
                   9811: 
                   9812: 		$(this.parent).append(modal);
                   9813: 
                   9814: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   9815: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   9816: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   9817: 	}
                   9818: };
1.1140    raeburn  9819: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      9820: 	{
1.1266    raeburn  9821:                 source = source.replace(/'/g,"&#39;");
1.1030    www      9822: 		modalWindow.windowId = "myModal";
                   9823: 		modalWindow.width = width;
                   9824: 		modalWindow.height = height;
1.1196    raeburn  9825: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      9826: 		modalWindow.open();
1.1208    raeburn  9827: 	};
1.1030    www      9828: // END LON-CAPA Internal -->
                   9829: // ]]>
                   9830: </script>
                   9831: ENDMODAL
                   9832: }
                   9833: 
                   9834: sub modal_link {
1.1140    raeburn  9835:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      9836:     unless ($width) { $width=480; }
                   9837:     unless ($height) { $height=400; }
1.1031    www      9838:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  9839:     unless ($transparency) { $transparency='true'; }
                   9840: 
1.1074    raeburn  9841:     my $target_attr;
                   9842:     if (defined($target)) {
                   9843:         $target_attr = 'target="'.$target.'"';
                   9844:     }
                   9845:     return <<"ENDLINK";
1.1336    raeburn  9846: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074    raeburn  9847: ENDLINK
1.1030    www      9848: }
                   9849: 
1.1032    www      9850: sub modal_adhoc_script {
1.1365    raeburn  9851:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
                   9852:     my $mathjax;
                   9853:     if ($possmathjax) {
                   9854:         $mathjax = <<'ENDJAX';
                   9855:                if (typeof MathJax == 'object') {
                   9856:                    MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
                   9857:                }
                   9858: ENDJAX
                   9859:     }
1.1032    www      9860:     return (<<ENDADHOC);
1.1046    raeburn  9861: <script type="text/javascript">
1.1032    www      9862: // <![CDATA[
                   9863:         var $funcname = function()
                   9864:         {
                   9865:                 modalWindow.windowId = "myModal";
                   9866:                 modalWindow.width = $width;
                   9867:                 modalWindow.height = $height;
                   9868:                 modalWindow.content = '$content';
                   9869:                 modalWindow.open();
1.1365    raeburn  9870:                 $mathjax
1.1032    www      9871:         };  
                   9872: // ]]>
                   9873: </script>
                   9874: ENDADHOC
                   9875: }
                   9876: 
1.1041    www      9877: sub modal_adhoc_inner {
1.1365    raeburn  9878:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041    www      9879:     my $innerwidth=$width-20;
                   9880:     $content=&js_ready(
1.1140    raeburn  9881:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   9882:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   9883:                  $content.
1.1041    www      9884:                  &end_scrollbox().
1.1140    raeburn  9885:                  &end_page()
1.1041    www      9886:              );
1.1365    raeburn  9887:     return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041    www      9888: }
                   9889: 
                   9890: sub modal_adhoc_window {
1.1365    raeburn  9891:     my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
                   9892:     return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041    www      9893:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   9894: }
                   9895: 
                   9896: sub modal_adhoc_launch {
                   9897:     my ($funcname,$width,$height,$content)=@_;
                   9898:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   9899: <script type="text/javascript">
                   9900: // <![CDATA[
                   9901: $funcname();
                   9902: // ]]>
                   9903: </script>
                   9904: ENDLAUNCH
                   9905: }
                   9906: 
                   9907: sub modal_adhoc_close {
                   9908:     return (<<ENDCLOSE);
                   9909: <script type="text/javascript">
                   9910: // <![CDATA[
                   9911: modalWindow.close();
                   9912: // ]]>
                   9913: </script>
                   9914: ENDCLOSE
                   9915: }
                   9916: 
1.1038    www      9917: sub togglebox_script {
                   9918:    return(<<ENDTOGGLE);
                   9919: <script type="text/javascript"> 
                   9920: // <![CDATA[
                   9921: function LCtoggleDisplay(id,hidetext,showtext) {
                   9922:    link = document.getElementById(id + "link").childNodes[0];
                   9923:    with (document.getElementById(id).style) {
                   9924:       if (display == "none" ) {
                   9925:           display = "inline";
                   9926:           link.nodeValue = hidetext;
                   9927:         } else {
                   9928:           display = "none";
                   9929:           link.nodeValue = showtext;
                   9930:        }
                   9931:    }
                   9932: }
                   9933: // ]]>
                   9934: </script>
                   9935: ENDTOGGLE
                   9936: }
                   9937: 
1.1039    www      9938: sub start_togglebox {
                   9939:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   9940:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   9941:     unless ($showtext) { $showtext=&mt('show'); }
                   9942:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   9943:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   9944:     return &start_data_table().
                   9945:            &start_data_table_header_row().
                   9946:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   9947:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   9948:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   9949:            &end_data_table_header_row().
                   9950:            '<tr id="'.$id.'" style="display:none""><td>';
                   9951: }
                   9952: 
                   9953: sub end_togglebox {
                   9954:     return '</td></tr>'.&end_data_table();
                   9955: }
                   9956: 
1.1041    www      9957: sub LCprogressbar_script {
1.1302    raeburn  9958:    my ($id,$number_to_do)=@_;
                   9959:    if ($number_to_do) {
                   9960:        return(<<ENDPROGRESS);
1.1041    www      9961: <script type="text/javascript">
                   9962: // <![CDATA[
1.1045    www      9963: \$('#progressbar$id').progressbar({
1.1041    www      9964:   value: 0,
                   9965:   change: function(event, ui) {
                   9966:     var newVal = \$(this).progressbar('option', 'value');
                   9967:     \$('.pblabel', this).text(LCprogressTxt);
                   9968:   }
                   9969: });
                   9970: // ]]>
                   9971: </script>
                   9972: ENDPROGRESS
1.1302    raeburn  9973:    } else {
                   9974:        return(<<ENDPROGRESS);
                   9975: <script type="text/javascript">
                   9976: // <![CDATA[
                   9977: \$('#progressbar$id').progressbar({
                   9978:   value: false,
                   9979:   create: function(event, ui) {
                   9980:     \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
                   9981:     \$('.ui-progressbar-overlay', this).css({'margin':'0'});
                   9982:   }
                   9983: });
                   9984: // ]]>
                   9985: </script>
                   9986: ENDPROGRESS
                   9987:    }
1.1041    www      9988: }
                   9989: 
                   9990: sub LCprogressbarUpdate_script {
                   9991:    return(<<ENDPROGRESSUPDATE);
                   9992: <style type="text/css">
                   9993: .ui-progressbar { position:relative; }
1.1302    raeburn  9994: .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      9995: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   9996: </style>
                   9997: <script type="text/javascript">
                   9998: // <![CDATA[
1.1045    www      9999: var LCprogressTxt='---';
                   10000: 
1.1302    raeburn  10001: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041    www      10002:    LCprogressTxt=progresstext;
1.1302    raeburn  10003:    if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
                   10004:        \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
                   10005:    } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301    raeburn  10006:        \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
                   10007:    } else {
                   10008:        \$('#progressbar'+id).progressbar('value',percent);
                   10009:    }
1.1041    www      10010: }
                   10011: // ]]>
                   10012: </script>
                   10013: ENDPROGRESSUPDATE
                   10014: }
                   10015: 
1.1042    www      10016: my $LClastpercent;
1.1045    www      10017: my $LCidcnt;
                   10018: my $LCcurrentid;
1.1042    www      10019: 
1.1041    www      10020: sub LCprogressbar {
1.1302    raeburn  10021:     my ($r,$number_to_do,$preamble)=@_;
1.1042    www      10022:     $LClastpercent=0;
1.1045    www      10023:     $LCidcnt++;
                   10024:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1302    raeburn  10025:     my ($starting,$content);
                   10026:     if ($number_to_do) {
                   10027:         $starting=&mt('Starting');
                   10028:         $content=(<<ENDPROGBAR);
                   10029: $preamble
1.1045    www      10030:   <div id="progressbar$LCcurrentid">
1.1041    www      10031:     <span class="pblabel">$starting</span>
                   10032:   </div>
                   10033: ENDPROGBAR
1.1302    raeburn  10034:     } else {
                   10035:         $starting=&mt('Loading...');
                   10036:         $LClastpercent='false';
                   10037:         $content=(<<ENDPROGBAR);
                   10038: $preamble
                   10039:   <div id="progressbar$LCcurrentid">
                   10040:       <div class="progress-label">$starting</div>
                   10041:   </div>
                   10042: ENDPROGBAR
                   10043:     }
                   10044:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041    www      10045: }
                   10046: 
                   10047: sub LCprogressbarUpdate {
1.1302    raeburn  10048:     my ($r,$val,$text,$number_to_do)=@_;
                   10049:     if ($number_to_do) {
                   10050:         unless ($val) { 
                   10051:             if ($LClastpercent) {
                   10052:                 $val=$LClastpercent;
                   10053:             } else {
                   10054:                 $val=0;
                   10055:             }
                   10056:         }
                   10057:         if ($val<0) { $val=0; }
                   10058:         if ($val>100) { $val=0; }
                   10059:         $LClastpercent=$val;
                   10060:         unless ($text) { $text=$val.'%'; }
                   10061:     } else {
                   10062:         $val = 'false';
1.1042    www      10063:     }
1.1041    www      10064:     $text=&js_ready($text);
1.1044    www      10065:     &r_print($r,<<ENDUPDATE);
1.1041    www      10066: <script type="text/javascript">
                   10067: // <![CDATA[
1.1302    raeburn  10068: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041    www      10069: // ]]>
                   10070: </script>
                   10071: ENDUPDATE
1.1035    www      10072: }
                   10073: 
1.1042    www      10074: sub LCprogressbarClose {
                   10075:     my ($r)=@_;
                   10076:     $LClastpercent=0;
1.1044    www      10077:     &r_print($r,<<ENDCLOSE);
1.1042    www      10078: <script type="text/javascript">
                   10079: // <![CDATA[
1.1045    www      10080: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      10081: // ]]>
                   10082: </script>
                   10083: ENDCLOSE
1.1044    www      10084: }
                   10085: 
                   10086: sub r_print {
                   10087:     my ($r,$to_print)=@_;
                   10088:     if ($r) {
                   10089:       $r->print($to_print);
                   10090:       $r->rflush();
                   10091:     } else {
                   10092:       print($to_print);
                   10093:     }
1.1042    www      10094: }
                   10095: 
1.320     albertel 10096: sub html_encode {
                   10097:     my ($result) = @_;
                   10098: 
1.322     albertel 10099:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 10100:     
                   10101:     return $result;
                   10102: }
1.1044    www      10103: 
1.317     albertel 10104: sub js_ready {
                   10105:     my ($result) = @_;
                   10106: 
1.323     albertel 10107:     $result =~ s/[\n\r]/ /xmsg;
                   10108:     $result =~ s/\\/\\\\/xmsg;
                   10109:     $result =~ s/'/\\'/xmsg;
1.372     albertel 10110:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 10111:     
                   10112:     return $result;
                   10113: }
                   10114: 
1.315     albertel 10115: sub validate_page {
                   10116:     if (  exists($env{'internal.start_page'})
1.316     albertel 10117: 	  &&     $env{'internal.start_page'} > 1) {
                   10118: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 10119: 				 $env{'internal.start_page'}.' '.
1.316     albertel 10120: 				 $ENV{'request.filename'});
1.315     albertel 10121:     }
                   10122:     if (  exists($env{'internal.end_page'})
1.316     albertel 10123: 	  &&     $env{'internal.end_page'} > 1) {
                   10124: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 10125: 				 $env{'internal.end_page'}.' '.
1.316     albertel 10126: 				 $env{'request.filename'});
1.315     albertel 10127:     }
                   10128:     if (     exists($env{'internal.start_page'})
                   10129: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 10130: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   10131: 				 $env{'request.filename'});
1.315     albertel 10132:     }
                   10133:     if (   ! exists($env{'internal.start_page'})
                   10134: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 10135: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   10136: 				 $env{'request.filename'});
1.315     albertel 10137:     }
1.306     albertel 10138: }
1.315     albertel 10139: 
1.996     www      10140: 
                   10141: sub start_scrollbox {
1.1140    raeburn  10142:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  10143:     unless ($outerwidth) { $outerwidth='520px'; }
                   10144:     unless ($width) { $width='500px'; }
                   10145:     unless ($height) { $height='200px'; }
1.1075    raeburn  10146:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  10147:     if ($id ne '') {
1.1140    raeburn  10148:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  10149:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  10150:     }
1.1075    raeburn  10151:     if ($bgcolor ne '') {
                   10152:         $tdcol = "background-color: $bgcolor;";
                   10153:     }
1.1137    raeburn  10154:     my $nicescroll_js;
                   10155:     if ($env{'browser.mobile'}) {
1.1140    raeburn  10156:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   10157:     }
                   10158:     return <<"END";
                   10159: $nicescroll_js
                   10160: 
                   10161: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   10162: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   10163: END
                   10164: }
                   10165: 
                   10166: sub end_scrollbox {
                   10167:     return '</div></td></tr></table>';
                   10168: }
                   10169: 
                   10170: sub nicescroll_javascript {
                   10171:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   10172:     my %options;
                   10173:     if (ref($cursor) eq 'HASH') {
                   10174:         %options = %{$cursor};
                   10175:     }
                   10176:     unless ($options{'railalign'} =~ /^left|right$/) {
                   10177:         $options{'railalign'} = 'left';
                   10178:     }
                   10179:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   10180:         my $function  = &get_users_function();
                   10181:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  10182:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  10183:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  10184:         }
1.1140    raeburn  10185:     }
                   10186:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   10187:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  10188:             $options{'cursoropacity'}='1.0';
                   10189:         }
1.1140    raeburn  10190:     } else {
                   10191:         $options{'cursoropacity'}='1.0';
                   10192:     }
                   10193:     if ($options{'cursorfixedheight'} eq 'none') {
                   10194:         delete($options{'cursorfixedheight'});
                   10195:     } else {
                   10196:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   10197:     }
                   10198:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   10199:         delete($options{'railoffset'});
                   10200:     }
                   10201:     my @niceoptions;
                   10202:     while (my($key,$value) = each(%options)) {
                   10203:         if ($value =~ /^\{.+\}$/) {
                   10204:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  10205:         } else {
1.1140    raeburn  10206:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  10207:         }
1.1140    raeburn  10208:     }
                   10209:     my $nicescroll_js = '
1.1137    raeburn  10210: $(document).ready(
1.1140    raeburn  10211:       function() {
                   10212:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   10213:       }
1.1137    raeburn  10214: );
                   10215: ';
1.1140    raeburn  10216:     if ($framecheck) {
                   10217:         $nicescroll_js .= '
                   10218: function expand_div(caller) {
                   10219:     if (top === self) {
                   10220:         document.getElementById("'.$id.'").style.width = "auto";
                   10221:         document.getElementById("'.$id.'").style.height = "auto";
                   10222:     } else {
                   10223:         try {
                   10224:             if (parent.frames) {
                   10225:                 if (parent.frames.length > 1) {
                   10226:                     var framesrc = parent.frames[1].location.href;
                   10227:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   10228:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   10229:                         document.getElementById("'.$id.'").style.width = "auto";
                   10230:                         document.getElementById("'.$id.'").style.height = "auto";
                   10231:                     }
                   10232:                 }
                   10233:             }
                   10234:         } catch (e) {
                   10235:             return;
                   10236:         }
1.1137    raeburn  10237:     }
1.1140    raeburn  10238:     return;
1.996     www      10239: }
1.1140    raeburn  10240: ';
                   10241:     }
                   10242:     if ($needjsready) {
                   10243:         $nicescroll_js = '
                   10244: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   10245:     } else {
                   10246:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   10247:     }
                   10248:     return $nicescroll_js;
1.996     www      10249: }
                   10250: 
1.318     albertel 10251: sub simple_error_page {
1.1150    bisitz   10252:     my ($r,$title,$msg,$args) = @_;
1.1304    raeburn  10253:     my %displayargs;
1.1151    raeburn  10254:     if (ref($args) eq 'HASH') {
                   10255:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304    raeburn  10256:         if ($args->{'only_body'}) {
                   10257:             $displayargs{'only_body'} = 1;
                   10258:         }
                   10259:         if ($args->{'no_nav_bar'}) {
                   10260:             $displayargs{'no_nav_bar'} = 1;
                   10261:         }
1.1151    raeburn  10262:     } else {
                   10263:         $msg = &mt($msg);
                   10264:     }
1.1150    bisitz   10265: 
1.318     albertel 10266:     my $page =
1.1304    raeburn  10267: 	&Apache::loncommon::start_page($title,'',\%displayargs).
1.1150    bisitz   10268: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 10269: 	&Apache::loncommon::end_page();
                   10270:     if (ref($r)) {
                   10271: 	$r->print($page);
1.327     albertel 10272: 	return;
1.318     albertel 10273:     }
                   10274:     return $page;
                   10275: }
1.347     albertel 10276: 
                   10277: {
1.610     albertel 10278:     my @row_count;
1.961     onken    10279: 
                   10280:     sub start_data_table_count {
                   10281:         unshift(@row_count, 0);
                   10282:         return;
                   10283:     }
                   10284: 
                   10285:     sub end_data_table_count {
                   10286:         shift(@row_count);
                   10287:         return;
                   10288:     }
                   10289: 
1.347     albertel 10290:     sub start_data_table {
1.1018    raeburn  10291: 	my ($add_class,$id) = @_;
1.422     albertel 10292: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  10293:         my $table_id;
                   10294:         if (defined($id)) {
                   10295:             $table_id = ' id="'.$id.'"';
                   10296:         }
1.961     onken    10297: 	&start_data_table_count();
1.1018    raeburn  10298: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 10299:     }
                   10300: 
                   10301:     sub end_data_table {
1.961     onken    10302: 	&end_data_table_count();
1.389     albertel 10303: 	return '</table>'."\n";;
1.347     albertel 10304:     }
                   10305: 
                   10306:     sub start_data_table_row {
1.974     wenzelju 10307: 	my ($add_class, $id) = @_;
1.610     albertel 10308: 	$row_count[0]++;
                   10309: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   10310: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 10311:         $id = (' id="'.$id.'"') unless ($id eq '');
                   10312:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 10313:     }
1.471     banghart 10314:     
                   10315:     sub continue_data_table_row {
1.974     wenzelju 10316: 	my ($add_class, $id) = @_;
1.610     albertel 10317: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 10318: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   10319:         $id = (' id="'.$id.'"') unless ($id eq '');
                   10320:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 10321:     }
1.347     albertel 10322: 
                   10323:     sub end_data_table_row {
1.389     albertel 10324: 	return '</tr>'."\n";;
1.347     albertel 10325:     }
1.367     www      10326: 
1.421     albertel 10327:     sub start_data_table_empty_row {
1.707     bisitz   10328: #	$row_count[0]++;
1.421     albertel 10329: 	return  '<tr class="LC_empty_row" >'."\n";;
                   10330:     }
                   10331: 
                   10332:     sub end_data_table_empty_row {
                   10333: 	return '</tr>'."\n";;
                   10334:     }
                   10335: 
1.367     www      10336:     sub start_data_table_header_row {
1.389     albertel 10337: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      10338:     }
                   10339: 
                   10340:     sub end_data_table_header_row {
1.389     albertel 10341: 	return '</tr>'."\n";;
1.367     www      10342:     }
1.890     droeschl 10343: 
                   10344:     sub data_table_caption {
                   10345:         my $caption = shift;
                   10346:         return "<caption class=\"LC_caption\">$caption</caption>";
                   10347:     }
1.347     albertel 10348: }
                   10349: 
1.548     albertel 10350: =pod
                   10351: 
                   10352: =item * &inhibit_menu_check($arg)
                   10353: 
                   10354: Checks for a inhibitmenu state and generates output to preserve it
                   10355: 
                   10356: Inputs:         $arg - can be any of
                   10357:                      - undef - in which case the return value is a string 
                   10358:                                to add  into arguments list of a uri
                   10359:                      - 'input' - in which case the return value is a HTML
                   10360:                                  <form> <input> field of type hidden to
                   10361:                                  preserve the value
                   10362:                      - a url - in which case the return value is the url with
                   10363:                                the neccesary cgi args added to preserve the
                   10364:                                inhibitmenu state
                   10365:                      - a ref to a url - no return value, but the string is
                   10366:                                         updated to include the neccessary cgi
                   10367:                                         args to preserve the inhibitmenu state
                   10368: 
                   10369: =cut
                   10370: 
                   10371: sub inhibit_menu_check {
                   10372:     my ($arg) = @_;
                   10373:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   10374:     if ($arg eq 'input') {
                   10375: 	if ($env{'form.inhibitmenu'}) {
                   10376: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   10377: 	} else {
                   10378: 	    return
                   10379: 	}
                   10380:     }
                   10381:     if ($env{'form.inhibitmenu'}) {
                   10382: 	if (ref($arg)) {
                   10383: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   10384: 	} elsif ($arg eq '') {
                   10385: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   10386: 	} else {
                   10387: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   10388: 	}
                   10389:     }
                   10390:     if (!ref($arg)) {
                   10391: 	return $arg;
                   10392:     }
                   10393: }
                   10394: 
1.251     albertel 10395: ###############################################
1.182     matthew  10396: 
                   10397: =pod
                   10398: 
1.549     albertel 10399: =back
                   10400: 
                   10401: =head1 User Information Routines
                   10402: 
                   10403: =over 4
                   10404: 
1.405     albertel 10405: =item * &get_users_function()
1.182     matthew  10406: 
                   10407: Used by &bodytag to determine the current users primary role.
                   10408: Returns either 'student','coordinator','admin', or 'author'.
                   10409: 
                   10410: =cut
                   10411: 
                   10412: ###############################################
                   10413: sub get_users_function {
1.815     tempelho 10414:     my $function = 'norole';
1.818     tempelho 10415:     if ($env{'request.role'}=~/^(st)/) {
                   10416:         $function='student';
                   10417:     }
1.907     raeburn  10418:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  10419:         $function='coordinator';
                   10420:     }
1.258     albertel 10421:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  10422:         $function='admin';
                   10423:     }
1.826     bisitz   10424:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  10425:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  10426:         $function='author';
                   10427:     }
                   10428:     return $function;
1.54      www      10429: }
1.99      www      10430: 
                   10431: ###############################################
                   10432: 
1.233     raeburn  10433: =pod
                   10434: 
1.821     raeburn  10435: =item * &show_course()
                   10436: 
                   10437: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   10438: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   10439: 
                   10440: Inputs:
                   10441: None
                   10442: 
                   10443: Outputs:
                   10444: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   10445: 
                   10446: =cut
                   10447: 
                   10448: ###############################################
                   10449: sub show_course {
                   10450:     my $course = !$env{'user.adv'};
                   10451:     if (!$env{'user.adv'}) {
                   10452:         foreach my $env (keys(%env)) {
                   10453:             next if ($env !~ m/^user\.priv\./);
                   10454:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   10455:                 $course = 0;
                   10456:                 last;
                   10457:             }
                   10458:         }
                   10459:     }
                   10460:     return $course;
                   10461: }
                   10462: 
                   10463: ###############################################
                   10464: 
                   10465: =pod
                   10466: 
1.542     raeburn  10467: =item * &check_user_status()
1.274     raeburn  10468: 
                   10469: Determines current status of supplied role for a
                   10470: specific user. Roles can be active, previous or future.
                   10471: 
                   10472: Inputs: 
                   10473: user's domain, user's username, course's domain,
1.375     raeburn  10474: course's number, optional section ID.
1.274     raeburn  10475: 
                   10476: Outputs:
                   10477: role status: active, previous or future. 
                   10478: 
                   10479: =cut
                   10480: 
                   10481: sub check_user_status {
1.412     raeburn  10482:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  10483:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202    raeburn  10484:     my @uroles = keys(%userinfo);
1.274     raeburn  10485:     my $srchstr;
                   10486:     my $active_chk = 'none';
1.412     raeburn  10487:     my $now = time;
1.274     raeburn  10488:     if (@uroles > 0) {
1.908     raeburn  10489:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  10490:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   10491:         } else {
1.412     raeburn  10492:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   10493:         }
                   10494:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  10495:             my $role_end = 0;
                   10496:             my $role_start = 0;
                   10497:             $active_chk = 'active';
1.412     raeburn  10498:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   10499:                 $role_end = $1;
                   10500:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   10501:                     $role_start = $1;
1.274     raeburn  10502:                 }
                   10503:             }
                   10504:             if ($role_start > 0) {
1.412     raeburn  10505:                 if ($now < $role_start) {
1.274     raeburn  10506:                     $active_chk = 'future';
                   10507:                 }
                   10508:             }
                   10509:             if ($role_end > 0) {
1.412     raeburn  10510:                 if ($now > $role_end) {
1.274     raeburn  10511:                     $active_chk = 'previous';
                   10512:                 }
                   10513:             }
                   10514:         }
                   10515:     }
                   10516:     return $active_chk;
                   10517: }
                   10518: 
                   10519: ###############################################
                   10520: 
                   10521: =pod
                   10522: 
1.405     albertel 10523: =item * &get_sections()
1.233     raeburn  10524: 
                   10525: Determines all the sections for a course including
                   10526: sections with students and sections containing other roles.
1.419     raeburn  10527: Incoming parameters: 
                   10528: 
                   10529: 1. domain
                   10530: 2. course number 
                   10531: 3. reference to array containing roles for which sections should 
                   10532: be gathered (optional).
                   10533: 4. reference to array containing status types for which sections 
                   10534: should be gathered (optional).
                   10535: 
                   10536: If the third argument is undefined, sections are gathered for any role. 
                   10537: If the fourth argument is undefined, sections are gathered for any status.
                   10538: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  10539:  
1.374     raeburn  10540: Returns section hash (keys are section IDs, values are
                   10541: number of users in each section), subject to the
1.419     raeburn  10542: optional roles filter, optional status filter 
1.233     raeburn  10543: 
                   10544: =cut
                   10545: 
                   10546: ###############################################
                   10547: sub get_sections {
1.419     raeburn  10548:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 10549:     if (!defined($cdom) || !defined($cnum)) {
                   10550:         my $cid =  $env{'request.course.id'};
                   10551: 
                   10552: 	return if (!defined($cid));
                   10553: 
                   10554:         $cdom = $env{'course.'.$cid.'.domain'};
                   10555:         $cnum = $env{'course.'.$cid.'.num'};
                   10556:     }
                   10557: 
                   10558:     my %sectioncount;
1.419     raeburn  10559:     my $now = time;
1.240     albertel 10560: 
1.1118    raeburn  10561:     my $check_students = 1;
                   10562:     my $only_students = 0;
                   10563:     if (ref($possible_roles) eq 'ARRAY') {
                   10564:         if (grep(/^st$/,@{$possible_roles})) {
                   10565:             if (@{$possible_roles} == 1) {
                   10566:                 $only_students = 1;
                   10567:             }
                   10568:         } else {
                   10569:             $check_students = 0;
                   10570:         }
                   10571:     }
                   10572: 
                   10573:     if ($check_students) { 
1.276     albertel 10574: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 10575: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   10576: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  10577:         my $start_index = &Apache::loncoursedata::CL_START();
                   10578:         my $end_index = &Apache::loncoursedata::CL_END();
                   10579:         my $status;
1.366     albertel 10580: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  10581: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   10582: 				                     $data->[$status_index],
                   10583:                                                      $data->[$start_index],
                   10584:                                                      $data->[$end_index]);
                   10585:             if ($stu_status eq 'Active') {
                   10586:                 $status = 'active';
                   10587:             } elsif ($end < $now) {
                   10588:                 $status = 'previous';
                   10589:             } elsif ($start > $now) {
                   10590:                 $status = 'future';
                   10591:             } 
                   10592: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   10593:                 if ((!defined($possible_status)) || (($status ne '') && 
                   10594:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   10595: 		    $sectioncount{$section}++;
                   10596:                 }
1.240     albertel 10597: 	    }
                   10598: 	}
                   10599:     }
1.1118    raeburn  10600:     if ($only_students) {
                   10601:         return %sectioncount;
                   10602:     }
1.240     albertel 10603:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   10604:     foreach my $user (sort(keys(%courseroles))) {
                   10605: 	if ($user !~ /^(\w{2})/) { next; }
                   10606: 	my ($role) = ($user =~ /^(\w{2})/);
                   10607: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  10608: 	my ($section,$status);
1.240     albertel 10609: 	if ($role eq 'cr' &&
                   10610: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   10611: 	    $section=$1;
                   10612: 	}
                   10613: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   10614: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  10615:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   10616:         if ($end == -1 && $start == -1) {
                   10617:             next; #deleted role
                   10618:         }
                   10619:         if (!defined($possible_status)) { 
                   10620:             $sectioncount{$section}++;
                   10621:         } else {
                   10622:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   10623:                 $status = 'active';
                   10624:             } elsif ($end < $now) {
                   10625:                 $status = 'future';
                   10626:             } elsif ($start > $now) {
                   10627:                 $status = 'previous';
                   10628:             }
                   10629:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   10630:                 $sectioncount{$section}++;
                   10631:             }
                   10632:         }
1.233     raeburn  10633:     }
1.366     albertel 10634:     return %sectioncount;
1.233     raeburn  10635: }
                   10636: 
1.274     raeburn  10637: ###############################################
1.294     raeburn  10638: 
                   10639: =pod
1.405     albertel 10640: 
                   10641: =item * &get_course_users()
                   10642: 
1.275     raeburn  10643: Retrieves usernames:domains for users in the specified course
                   10644: with specific role(s), and access status. 
                   10645: 
                   10646: Incoming parameters:
1.277     albertel 10647: 1. course domain
                   10648: 2. course number
                   10649: 3. access status: users must have - either active, 
1.275     raeburn  10650: previous, future, or all.
1.277     albertel 10651: 4. reference to array of permissible roles
1.288     raeburn  10652: 5. reference to array of section restrictions (optional)
                   10653: 6. reference to results object (hash of hashes).
                   10654: 7. reference to optional userdata hash
1.609     raeburn  10655: 8. reference to optional statushash
1.630     raeburn  10656: 9. flag if privileged users (except those set to unhide in
                   10657:    course settings) should be excluded    
1.609     raeburn  10658: Keys of top level results hash are roles.
1.275     raeburn  10659: Keys of inner hashes are username:domain, with 
                   10660: values set to access type.
1.288     raeburn  10661: Optional userdata hash returns an array with arguments in the 
                   10662: same order as loncoursedata::get_classlist() for student data.
                   10663: 
1.609     raeburn  10664: Optional statushash returns
                   10665: 
1.288     raeburn  10666: Entries for end, start, section and status are blank because
                   10667: of the possibility of multiple values for non-student roles.
                   10668: 
1.275     raeburn  10669: =cut
1.405     albertel 10670: 
1.275     raeburn  10671: ###############################################
1.405     albertel 10672: 
1.275     raeburn  10673: sub get_course_users {
1.630     raeburn  10674:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  10675:     my %idx = ();
1.419     raeburn  10676:     my %seclists;
1.288     raeburn  10677: 
                   10678:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   10679:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   10680:     $idx{end} = &Apache::loncoursedata::CL_END();
                   10681:     $idx{start} = &Apache::loncoursedata::CL_START();
                   10682:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   10683:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   10684:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   10685:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   10686: 
1.290     albertel 10687:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 10688:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  10689:         my $now = time;
1.277     albertel 10690:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  10691:             my $match = 0;
1.412     raeburn  10692:             my $secmatch = 0;
1.419     raeburn  10693:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  10694:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  10695:             if ($section eq '') {
                   10696:                 $section = 'none';
                   10697:             }
1.291     albertel 10698:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 10699:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  10700:                     $secmatch = 1;
                   10701:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 10702:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  10703:                         $secmatch = 1;
                   10704:                     }
                   10705:                 } else {  
1.419     raeburn  10706: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  10707: 		        $secmatch = 1;
                   10708:                     }
1.290     albertel 10709: 		}
1.412     raeburn  10710:                 if (!$secmatch) {
                   10711:                     next;
                   10712:                 }
1.419     raeburn  10713:             }
1.275     raeburn  10714:             if (defined($$types{'active'})) {
1.288     raeburn  10715:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  10716:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  10717:                     $match = 1;
1.275     raeburn  10718:                 }
                   10719:             }
                   10720:             if (defined($$types{'previous'})) {
1.609     raeburn  10721:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  10722:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  10723:                     $match = 1;
1.275     raeburn  10724:                 }
                   10725:             }
                   10726:             if (defined($$types{'future'})) {
1.609     raeburn  10727:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  10728:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  10729:                     $match = 1;
1.275     raeburn  10730:                 }
                   10731:             }
1.609     raeburn  10732:             if ($match) {
                   10733:                 push(@{$seclists{$student}},$section);
                   10734:                 if (ref($userdata) eq 'HASH') {
                   10735:                     $$userdata{$student} = $$classlist{$student};
                   10736:                 }
                   10737:                 if (ref($statushash) eq 'HASH') {
                   10738:                     $statushash->{$student}{'st'}{$section} = $status;
                   10739:                 }
1.288     raeburn  10740:             }
1.275     raeburn  10741:         }
                   10742:     }
1.412     raeburn  10743:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  10744:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   10745:         my $now = time;
1.609     raeburn  10746:         my %displaystatus = ( previous => 'Expired',
                   10747:                               active   => 'Active',
                   10748:                               future   => 'Future',
                   10749:                             );
1.1121    raeburn  10750:         my (%nothide,@possdoms);
1.630     raeburn  10751:         if ($hidepriv) {
                   10752:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   10753:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   10754:                 if ($user !~ /:/) {
                   10755:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   10756:                 } else {
                   10757:                     $nothide{$user} = 1;
                   10758:                 }
                   10759:             }
1.1121    raeburn  10760:             my @possdoms = ($cdom);
                   10761:             if ($coursehash{'checkforpriv'}) {
                   10762:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   10763:             }
1.630     raeburn  10764:         }
1.439     raeburn  10765:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  10766:             my $match = 0;
1.412     raeburn  10767:             my $secmatch = 0;
1.439     raeburn  10768:             my $status;
1.412     raeburn  10769:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  10770:             $user =~ s/:$//;
1.439     raeburn  10771:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   10772:             if ($end == -1 || $start == -1) {
                   10773:                 next;
                   10774:             }
                   10775:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   10776:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  10777:                 my ($uname,$udom) = split(/:/,$user);
                   10778:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 10779:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  10780:                         $secmatch = 1;
                   10781:                     } elsif ($usec eq '') {
1.420     albertel 10782:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  10783:                             $secmatch = 1;
                   10784:                         }
                   10785:                     } else {
                   10786:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   10787:                             $secmatch = 1;
                   10788:                         }
                   10789:                     }
                   10790:                     if (!$secmatch) {
                   10791:                         next;
                   10792:                     }
1.288     raeburn  10793:                 }
1.419     raeburn  10794:                 if ($usec eq '') {
                   10795:                     $usec = 'none';
                   10796:                 }
1.275     raeburn  10797:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  10798:                     if ($hidepriv) {
1.1121    raeburn  10799:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  10800:                             (!$nothide{$uname.':'.$udom})) {
                   10801:                             next;
                   10802:                         }
                   10803:                     }
1.503     raeburn  10804:                     if ($end > 0 && $end < $now) {
1.439     raeburn  10805:                         $status = 'previous';
                   10806:                     } elsif ($start > $now) {
                   10807:                         $status = 'future';
                   10808:                     } else {
                   10809:                         $status = 'active';
                   10810:                     }
1.277     albertel 10811:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  10812:                         if ($status eq $type) {
1.420     albertel 10813:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  10814:                                 push(@{$$users{$role}{$user}},$type);
                   10815:                             }
1.288     raeburn  10816:                             $match = 1;
                   10817:                         }
                   10818:                     }
1.419     raeburn  10819:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   10820:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   10821: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   10822:                         }
1.420     albertel 10823:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  10824:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   10825:                         }
1.609     raeburn  10826:                         if (ref($statushash) eq 'HASH') {
                   10827:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   10828:                         }
1.275     raeburn  10829:                     }
                   10830:                 }
                   10831:             }
                   10832:         }
1.290     albertel 10833:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  10834:             if ((defined($cdom)) && (defined($cnum))) {
                   10835:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   10836:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   10837:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  10838:                     next if ($owner eq '');
                   10839:                     my ($ownername,$ownerdom);
                   10840:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   10841:                         $ownername = $1;
                   10842:                         $ownerdom = $2;
                   10843:                     } else {
                   10844:                         $ownername = $owner;
                   10845:                         $ownerdom = $cdom;
                   10846:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  10847:                     }
                   10848:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 10849:                     if (defined($userdata) && 
1.609     raeburn  10850: 			!exists($$userdata{$owner})) {
                   10851: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   10852:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   10853:                             push(@{$seclists{$owner}},'none');
                   10854:                         }
                   10855:                         if (ref($statushash) eq 'HASH') {
                   10856:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  10857:                         }
1.290     albertel 10858: 		    }
1.279     raeburn  10859:                 }
                   10860:             }
                   10861:         }
1.419     raeburn  10862:         foreach my $user (keys(%seclists)) {
                   10863:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   10864:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   10865:         }
1.275     raeburn  10866:     }
                   10867:     return;
                   10868: }
                   10869: 
1.288     raeburn  10870: sub get_user_info {
                   10871:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 10872:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   10873: 	&plainname($uname,$udom,'lastname');
1.291     albertel 10874:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  10875:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  10876:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   10877:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  10878:     return;
                   10879: }
1.275     raeburn  10880: 
1.472     raeburn  10881: ###############################################
                   10882: 
                   10883: =pod
                   10884: 
                   10885: =item * &get_user_quota()
                   10886: 
1.1134    raeburn  10887: Retrieves quota assigned for storage of user files.
                   10888: Default is to report quota for portfolio files.
1.472     raeburn  10889: 
                   10890: Incoming parameters:
                   10891: 1. user's username
                   10892: 2. user's domain
1.1134    raeburn  10893: 3. quota name - portfolio, author, or course
1.1136    raeburn  10894:    (if no quota name provided, defaults to portfolio).
1.1237    raeburn  10895: 4. crstype - official, unofficial, textbook, placement or community, 
                   10896:    if quota name is course
1.472     raeburn  10897: 
                   10898: Returns:
1.1163    raeburn  10899: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  10900: 2. (Optional) Type of setting: custom or default
                   10901:    (individually assigned or default for user's 
                   10902:    institutional status).
                   10903: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   10904:    or student - types as defined in localenroll::inst_usertypes 
                   10905:    for user's domain, which determines default quota for user.
                   10906: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  10907: 
                   10908: If a value has been stored in the user's environment, 
1.536     raeburn  10909: it will return that, otherwise it returns the maximal default
1.1134    raeburn  10910: defined for the user's institutional status(es) in the domain.
1.472     raeburn  10911: 
                   10912: =cut
                   10913: 
                   10914: ###############################################
                   10915: 
                   10916: 
                   10917: sub get_user_quota {
1.1136    raeburn  10918:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  10919:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  10920:     if (!defined($udom)) {
                   10921:         $udom = $env{'user.domain'};
                   10922:     }
                   10923:     if (!defined($uname)) {
                   10924:         $uname = $env{'user.name'};
                   10925:     }
                   10926:     if (($udom eq '' || $uname eq '') ||
                   10927:         ($udom eq 'public') && ($uname eq 'public')) {
                   10928:         $quota = 0;
1.536     raeburn  10929:         $quotatype = 'default';
                   10930:         $defquota = 0; 
1.472     raeburn  10931:     } else {
1.536     raeburn  10932:         my $inststatus;
1.1134    raeburn  10933:         if ($quotaname eq 'course') {
                   10934:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   10935:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   10936:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   10937:             } else {
                   10938:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   10939:                 $quota = $cenv{'internal.uploadquota'};
                   10940:             }
1.536     raeburn  10941:         } else {
1.1134    raeburn  10942:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   10943:                 if ($quotaname eq 'author') {
                   10944:                     $quota = $env{'environment.authorquota'};
                   10945:                 } else {
                   10946:                     $quota = $env{'environment.portfolioquota'};
                   10947:                 }
                   10948:                 $inststatus = $env{'environment.inststatus'};
                   10949:             } else {
                   10950:                 my %userenv = 
                   10951:                     &Apache::lonnet::get('environment',['portfolioquota',
                   10952:                                          'authorquota','inststatus'],$udom,$uname);
                   10953:                 my ($tmp) = keys(%userenv);
                   10954:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   10955:                     if ($quotaname eq 'author') {
                   10956:                         $quota = $userenv{'authorquota'};
                   10957:                     } else {
                   10958:                         $quota = $userenv{'portfolioquota'};
                   10959:                     }
                   10960:                     $inststatus = $userenv{'inststatus'};
                   10961:                 } else {
                   10962:                     undef(%userenv);
                   10963:                 }
                   10964:             }
                   10965:         }
                   10966:         if ($quota eq '' || wantarray) {
                   10967:             if ($quotaname eq 'course') {
                   10968:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  10969:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
1.1237    raeburn  10970:                     ($crstype eq 'community') || ($crstype eq 'textbook') ||
                   10971:                     ($crstype eq 'placement')) { 
1.1136    raeburn  10972:                     $defquota = $domdefs{$crstype.'quota'};
                   10973:                 }
                   10974:                 if ($defquota eq '') {
                   10975:                     $defquota = 500;
                   10976:                 }
1.1134    raeburn  10977:             } else {
                   10978:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   10979:             }
                   10980:             if ($quota eq '') {
                   10981:                 $quota = $defquota;
                   10982:                 $quotatype = 'default';
                   10983:             } else {
                   10984:                 $quotatype = 'custom';
                   10985:             }
1.472     raeburn  10986:         }
                   10987:     }
1.536     raeburn  10988:     if (wantarray) {
                   10989:         return ($quota,$quotatype,$settingstatus,$defquota);
                   10990:     } else {
                   10991:         return $quota;
                   10992:     }
1.472     raeburn  10993: }
                   10994: 
                   10995: ###############################################
                   10996: 
                   10997: =pod
                   10998: 
                   10999: =item * &default_quota()
                   11000: 
1.536     raeburn  11001: Retrieves default quota assigned for storage of user portfolio files,
                   11002: given an (optional) user's institutional status.
1.472     raeburn  11003: 
                   11004: Incoming parameters:
1.1142    raeburn  11005: 
1.472     raeburn  11006: 1. domain
1.536     raeburn  11007: 2. (Optional) institutional status(es).  This is a : separated list of 
                   11008:    status types (e.g., faculty, staff, student etc.)
                   11009:    which apply to the user for whom the default is being retrieved.
                   11010:    If the institutional status string in undefined, the domain
1.1134    raeburn  11011:    default quota will be returned.
                   11012: 3.  quota name - portfolio, author, or course
                   11013:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  11014: 
                   11015: Returns:
1.1142    raeburn  11016: 
1.1163    raeburn  11017: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  11018: 2. (Optional) institutional type which determined the value of the
                   11019:    default quota.
1.472     raeburn  11020: 
                   11021: If a value has been stored in the domain's configuration db,
                   11022: it will return that, otherwise it returns 20 (for backwards 
                   11023: compatibility with domains which have not set up a configuration
1.1163    raeburn  11024: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  11025: 
1.536     raeburn  11026: If the user's status includes multiple types (e.g., staff and student),
                   11027: the largest default quota which applies to the user determines the
                   11028: default quota returned.
                   11029: 
1.472     raeburn  11030: =cut
                   11031: 
                   11032: ###############################################
                   11033: 
                   11034: 
                   11035: sub default_quota {
1.1134    raeburn  11036:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  11037:     my ($defquota,$settingstatus);
                   11038:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  11039:                                             ['quotas'],$udom);
1.1134    raeburn  11040:     my $key = 'defaultquota';
                   11041:     if ($quotaname eq 'author') {
                   11042:         $key = 'authorquota';
                   11043:     }
1.622     raeburn  11044:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  11045:         if ($inststatus ne '') {
1.765     raeburn  11046:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  11047:             foreach my $item (@statuses) {
1.1134    raeburn  11048:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   11049:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  11050:                         if ($defquota eq '') {
1.1134    raeburn  11051:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  11052:                             $settingstatus = $item;
1.1134    raeburn  11053:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   11054:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  11055:                             $settingstatus = $item;
                   11056:                         }
                   11057:                     }
1.1134    raeburn  11058:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  11059:                     if ($quotahash{'quotas'}{$item} ne '') {
                   11060:                         if ($defquota eq '') {
                   11061:                             $defquota = $quotahash{'quotas'}{$item};
                   11062:                             $settingstatus = $item;
                   11063:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   11064:                             $defquota = $quotahash{'quotas'}{$item};
                   11065:                             $settingstatus = $item;
                   11066:                         }
1.536     raeburn  11067:                     }
                   11068:                 }
                   11069:             }
                   11070:         }
                   11071:         if ($defquota eq '') {
1.1134    raeburn  11072:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   11073:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   11074:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  11075:                 $defquota = $quotahash{'quotas'}{'default'};
                   11076:             }
1.536     raeburn  11077:             $settingstatus = 'default';
1.1139    raeburn  11078:             if ($defquota eq '') {
                   11079:                 if ($quotaname eq 'author') {
                   11080:                     $defquota = 500;
                   11081:                 }
                   11082:             }
1.536     raeburn  11083:         }
                   11084:     } else {
                   11085:         $settingstatus = 'default';
1.1134    raeburn  11086:         if ($quotaname eq 'author') {
                   11087:             $defquota = 500;
                   11088:         } else {
                   11089:             $defquota = 20;
                   11090:         }
1.536     raeburn  11091:     }
                   11092:     if (wantarray) {
                   11093:         return ($defquota,$settingstatus);
1.472     raeburn  11094:     } else {
1.536     raeburn  11095:         return $defquota;
1.472     raeburn  11096:     }
                   11097: }
                   11098: 
1.1135    raeburn  11099: ###############################################
                   11100: 
                   11101: =pod
                   11102: 
1.1136    raeburn  11103: =item * &excess_filesize_warning()
1.1135    raeburn  11104: 
                   11105: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  11106: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  11107: space to be exceeded.
1.1136    raeburn  11108: 
                   11109: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  11110: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  11111: 
1.1165    raeburn  11112: Inputs: 7 
1.1136    raeburn  11113: 1. username or coursenum
1.1135    raeburn  11114: 2. domain
1.1136    raeburn  11115: 3. context ('author' or 'course')
1.1135    raeburn  11116: 4. filename of file for which action is being requested
                   11117: 5. filesize (kB) of file
                   11118: 6. action being taken: copy or upload.
1.1237    raeburn  11119: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135    raeburn  11120: 
                   11121: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  11122:          otherwise return null.
                   11123: 
                   11124: =back
1.1135    raeburn  11125: 
                   11126: =cut
                   11127: 
1.1136    raeburn  11128: sub excess_filesize_warning {
1.1165    raeburn  11129:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  11130:     my $current_disk_usage = 0;
1.1165    raeburn  11131:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  11132:     if ($context eq 'author') {
                   11133:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   11134:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   11135:     } else {
                   11136:         foreach my $subdir ('docs','supplemental') {
                   11137:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   11138:         }
                   11139:     }
1.1135    raeburn  11140:     $disk_quota = int($disk_quota * 1000);
                   11141:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   11142:         return '<p class="LC_warning">'.
1.1135    raeburn  11143:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   11144:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   11145:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  11146:                             $disk_quota,$current_disk_usage).
                   11147:                '</p>';
                   11148:     }
                   11149:     return;
                   11150: }
                   11151: 
                   11152: ###############################################
                   11153: 
                   11154: 
1.1136    raeburn  11155: 
                   11156: 
1.384     raeburn  11157: sub get_secgrprole_info {
                   11158:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   11159:     my %sections_count = &get_sections($cdom,$cnum);
                   11160:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   11161:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   11162:     my @groups = sort(keys(%curr_groups));
                   11163:     my $allroles = [];
                   11164:     my $rolehash;
                   11165:     my $accesshash = {
                   11166:                      active => 'Currently has access',
                   11167:                      future => 'Will have future access',
                   11168:                      previous => 'Previously had access',
                   11169:                   };
                   11170:     if ($needroles) {
                   11171:         $rolehash = {'all' => 'all'};
1.385     albertel 11172:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   11173: 	if (&Apache::lonnet::error(%user_roles)) {
                   11174: 	    undef(%user_roles);
                   11175: 	}
                   11176:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  11177:             my ($role)=split(/\:/,$item,2);
                   11178:             if ($role eq 'cr') { next; }
                   11179:             if ($role =~ /^cr/) {
                   11180:                 $$rolehash{$role} = (split('/',$role))[3];
                   11181:             } else {
                   11182:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   11183:             }
                   11184:         }
                   11185:         foreach my $key (sort(keys(%{$rolehash}))) {
                   11186:             push(@{$allroles},$key);
                   11187:         }
                   11188:         push (@{$allroles},'st');
                   11189:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   11190:     }
                   11191:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   11192: }
                   11193: 
1.555     raeburn  11194: sub user_picker {
1.1279    raeburn  11195:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555     raeburn  11196:     my $currdom = $dom;
1.1253    raeburn  11197:     my @alldoms = &Apache::lonnet::all_domains();
                   11198:     if (@alldoms == 1) {
                   11199:         my %domsrch = &Apache::lonnet::get_dom('configuration',
                   11200:                                                ['directorysrch'],$alldoms[0]);
                   11201:         my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
                   11202:         my $showdom = $domdesc;
                   11203:         if ($showdom eq '') {
                   11204:             $showdom = $dom;
                   11205:         }
                   11206:         if (ref($domsrch{'directorysrch'}) eq 'HASH') {
                   11207:             if ((!$domsrch{'directorysrch'}{'available'}) &&
                   11208:                 ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   11209:                 return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
                   11210:             }
                   11211:         }
                   11212:     }
1.555     raeburn  11213:     my %curr_selected = (
                   11214:                         srchin => 'dom',
1.580     raeburn  11215:                         srchby => 'lastname',
1.555     raeburn  11216:                       );
                   11217:     my $srchterm;
1.625     raeburn  11218:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  11219:         if ($srch->{'srchby'} ne '') {
                   11220:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   11221:         }
                   11222:         if ($srch->{'srchin'} ne '') {
                   11223:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   11224:         }
                   11225:         if ($srch->{'srchtype'} ne '') {
                   11226:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   11227:         }
                   11228:         if ($srch->{'srchdomain'} ne '') {
                   11229:             $currdom = $srch->{'srchdomain'};
                   11230:         }
                   11231:         $srchterm = $srch->{'srchterm'};
                   11232:     }
1.1222    damieng  11233:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  11234:                     'usr'       => 'Search criteria',
1.563     raeburn  11235:                     'doma'      => 'Domain/institution to search',
1.558     albertel 11236:                     'uname'     => 'username',
                   11237:                     'lastname'  => 'last name',
1.555     raeburn  11238:                     'lastfirst' => 'last name, first name',
1.558     albertel 11239:                     'crs'       => 'in this course',
1.576     raeburn  11240:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 11241:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  11242:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 11243:                     'exact'     => 'is',
                   11244:                     'contains'  => 'contains',
1.569     raeburn  11245:                     'begins'    => 'begins with',
1.1222    damieng  11246:                                        );
                   11247:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  11248:                     'youm'      => "You must include some text to search for.",
                   11249:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   11250:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   11251:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   11252:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   11253:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   11254:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   11255:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  11256:                                        );
1.1222    damieng  11257:     &html_escape(\%html_lt);
                   11258:     &js_escape(\%js_lt);
1.1255    raeburn  11259:     my $domform;
1.1277    raeburn  11260:     my $allow_blank = 1;
1.1255    raeburn  11261:     if ($fixeddom) {
1.1277    raeburn  11262:         $allow_blank = 0;
                   11263:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255    raeburn  11264:     } else {
1.1287    raeburn  11265:         my $defdom = $env{'request.role.domain'};
1.1288    raeburn  11266:         my ($trusted,$untrusted);
1.1287    raeburn  11267:         if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288    raeburn  11268:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287    raeburn  11269:         } elsif ($context eq 'author') {
1.1288    raeburn  11270:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287    raeburn  11271:         } elsif ($context eq 'domain') {
1.1288    raeburn  11272:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287    raeburn  11273:         }
1.1288    raeburn  11274:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255    raeburn  11275:     }
1.563     raeburn  11276:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  11277: 
                   11278:     my @srchins = ('crs','dom','alc','instd');
                   11279: 
                   11280:     foreach my $option (@srchins) {
                   11281:         # FIXME 'alc' option unavailable until 
                   11282:         #       loncreateuser::print_user_query_page()
                   11283:         #       has been completed.
                   11284:         next if ($option eq 'alc');
1.880     raeburn  11285:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  11286:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279    raeburn  11287:         next if (($option eq 'instd') && ($noinstd));
1.563     raeburn  11288:         if ($curr_selected{'srchin'} eq $option) {
                   11289:             $srchinsel .= ' 
1.1222    damieng  11290:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  11291:         } else {
                   11292:             $srchinsel .= '
1.1222    damieng  11293:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  11294:         }
1.555     raeburn  11295:     }
1.563     raeburn  11296:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  11297: 
                   11298:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  11299:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  11300:         if ($curr_selected{'srchby'} eq $option) {
                   11301:             $srchbysel .= '
1.1222    damieng  11302:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  11303:         } else {
                   11304:             $srchbysel .= '
1.1222    damieng  11305:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  11306:          }
                   11307:     }
                   11308:     $srchbysel .= "\n  </select>\n";
                   11309: 
                   11310:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  11311:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  11312:         if ($curr_selected{'srchtype'} eq $option) {
                   11313:             $srchtypesel .= '
1.1222    damieng  11314:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  11315:         } else {
                   11316:             $srchtypesel .= '
1.1222    damieng  11317:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  11318:         }
                   11319:     }
                   11320:     $srchtypesel .= "\n  </select>\n";
                   11321: 
1.558     albertel 11322:     my ($newuserscript,$new_user_create);
1.994     raeburn  11323:     my $context_dom = $env{'request.role.domain'};
                   11324:     if ($context eq 'requestcrs') {
                   11325:         if ($env{'form.coursedom'} ne '') { 
                   11326:             $context_dom = $env{'form.coursedom'};
                   11327:         }
                   11328:     }
1.556     raeburn  11329:     if ($forcenewuser) {
1.576     raeburn  11330:         if (ref($srch) eq 'HASH') {
1.994     raeburn  11331:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  11332:                 if ($cancreate) {
                   11333:                     $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>';
                   11334:                 } else {
1.799     bisitz   11335:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  11336:                     my %usertypetext = (
                   11337:                         official   => 'institutional',
                   11338:                         unofficial => 'non-institutional',
                   11339:                     );
1.799     bisitz   11340:                     $new_user_create = '<p class="LC_warning">'
                   11341:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   11342:                                       .' '
                   11343:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   11344:                                           ,'<a href="'.$helplink.'">','</a>')
                   11345:                                       .'</p><br />';
1.627     raeburn  11346:                 }
1.576     raeburn  11347:             }
                   11348:         }
                   11349: 
1.556     raeburn  11350:         $newuserscript = <<"ENDSCRIPT";
                   11351: 
1.570     raeburn  11352: function setSearch(createnew,callingForm) {
1.556     raeburn  11353:     if (createnew == 1) {
1.570     raeburn  11354:         for (var i=0; i<callingForm.srchby.length; i++) {
                   11355:             if (callingForm.srchby.options[i].value == 'uname') {
                   11356:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  11357:             }
                   11358:         }
1.570     raeburn  11359:         for (var i=0; i<callingForm.srchin.length; i++) {
                   11360:             if ( callingForm.srchin.options[i].value == 'dom') {
                   11361: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  11362:             }
                   11363:         }
1.570     raeburn  11364:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   11365:             if (callingForm.srchtype.options[i].value == 'exact') {
                   11366:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  11367:             }
                   11368:         }
1.570     raeburn  11369:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  11370:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  11371:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  11372:             }
                   11373:         }
                   11374:     }
                   11375: }
                   11376: ENDSCRIPT
1.558     albertel 11377: 
1.556     raeburn  11378:     }
                   11379: 
1.555     raeburn  11380:     my $output = <<"END_BLOCK";
1.556     raeburn  11381: <script type="text/javascript">
1.824     bisitz   11382: // <![CDATA[
1.570     raeburn  11383: function validateEntry(callingForm) {
1.558     albertel 11384: 
1.556     raeburn  11385:     var checkok = 1;
1.558     albertel 11386:     var srchin;
1.570     raeburn  11387:     for (var i=0; i<callingForm.srchin.length; i++) {
                   11388: 	if ( callingForm.srchin[i].checked ) {
                   11389: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 11390: 	}
                   11391:     }
                   11392: 
1.570     raeburn  11393:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   11394:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   11395:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   11396:     var srchterm =  callingForm.srchterm.value;
                   11397:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  11398:     var msg = "";
                   11399: 
                   11400:     if (srchterm == "") {
                   11401:         checkok = 0;
1.1222    damieng  11402:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  11403:     }
                   11404: 
1.569     raeburn  11405:     if (srchtype== 'begins') {
                   11406:         if (srchterm.length < 2) {
                   11407:             checkok = 0;
1.1222    damieng  11408:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  11409:         }
                   11410:     }
                   11411: 
1.556     raeburn  11412:     if (srchtype== 'contains') {
                   11413:         if (srchterm.length < 3) {
                   11414:             checkok = 0;
1.1222    damieng  11415:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  11416:         }
                   11417:     }
                   11418:     if (srchin == 'instd') {
                   11419:         if (srchdomain == '') {
                   11420:             checkok = 0;
1.1222    damieng  11421:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  11422:         }
                   11423:     }
                   11424:     if (srchin == 'dom') {
                   11425:         if (srchdomain == '') {
                   11426:             checkok = 0;
1.1222    damieng  11427:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  11428:         }
                   11429:     }
                   11430:     if (srchby == 'lastfirst') {
                   11431:         if (srchterm.indexOf(",") == -1) {
                   11432:             checkok = 0;
1.1222    damieng  11433:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  11434:         }
                   11435:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   11436:             checkok = 0;
1.1222    damieng  11437:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  11438:         }
                   11439:     }
                   11440:     if (checkok == 0) {
1.1222    damieng  11441:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  11442:         return;
                   11443:     }
                   11444:     if (checkok == 1) {
1.570     raeburn  11445:         callingForm.submit();
1.556     raeburn  11446:     }
                   11447: }
                   11448: 
                   11449: $newuserscript
                   11450: 
1.824     bisitz   11451: // ]]>
1.556     raeburn  11452: </script>
1.558     albertel 11453: 
                   11454: $new_user_create
                   11455: 
1.555     raeburn  11456: END_BLOCK
1.558     albertel 11457: 
1.876     raeburn  11458:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222    damieng  11459:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  11460:                $domform.
                   11461:                &Apache::lonhtmlcommon::row_closure().
1.1222    damieng  11462:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  11463:                $srchbysel.
                   11464:                $srchtypesel. 
                   11465:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   11466:                $srchinsel.
                   11467:                &Apache::lonhtmlcommon::row_closure(1). 
                   11468:                &Apache::lonhtmlcommon::end_pick_box().
                   11469:                '<br />';
1.1253    raeburn  11470:     return ($output,1);
1.555     raeburn  11471: }
                   11472: 
1.612     raeburn  11473: sub user_rule_check {
1.615     raeburn  11474:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226    raeburn  11475:     my ($response,%inst_response);
1.612     raeburn  11476:     if (ref($usershash) eq 'HASH') {
1.1226    raeburn  11477:         if (keys(%{$usershash}) > 1) {
                   11478:             my (%by_username,%by_id,%userdoms);
                   11479:             my $checkid; 
                   11480:             if (ref($checks) eq 'HASH') {
                   11481:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   11482:                     $checkid = 1;
                   11483:                 }
                   11484:             }
                   11485:             foreach my $user (keys(%{$usershash})) {
                   11486:                 my ($uname,$udom) = split(/:/,$user);
                   11487:                 if ($checkid) {
                   11488:                     if (ref($usershash->{$user}) eq 'HASH') {
                   11489:                         if ($usershash->{$user}->{'id'} ne '') {
1.1227    raeburn  11490:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
1.1226    raeburn  11491:                             $userdoms{$udom} = 1;
1.1227    raeburn  11492:                             if (ref($inst_results) eq 'HASH') {
                   11493:                                 $inst_results->{$uname.':'.$udom} = {};
                   11494:                             }
1.1226    raeburn  11495:                         }
                   11496:                     }
                   11497:                 } else {
                   11498:                     $by_username{$udom}{$uname} = 1;
                   11499:                     $userdoms{$udom} = 1;
1.1227    raeburn  11500:                     if (ref($inst_results) eq 'HASH') {
                   11501:                         $inst_results->{$uname.':'.$udom} = {};
                   11502:                     }
1.1226    raeburn  11503:                 }
                   11504:             }
                   11505:             foreach my $udom (keys(%userdoms)) {
                   11506:                 if (!$got_rules->{$udom}) {
                   11507:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   11508:                                                              ['usercreation'],$udom);
                   11509:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   11510:                         foreach my $item ('username','id') {
                   11511:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227    raeburn  11512:                                 $$curr_rules{$udom}{$item} =
                   11513:                                     $domconfig{'usercreation'}{$item.'_rule'};
1.1226    raeburn  11514:                             }
                   11515:                         }
                   11516:                     }
                   11517:                     $got_rules->{$udom} = 1;
                   11518:                 }
1.612     raeburn  11519:             }
1.1226    raeburn  11520:             if ($checkid) {
                   11521:                 foreach my $udom (keys(%by_id)) {
                   11522:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   11523:                     if ($outcome eq 'ok') {
1.1227    raeburn  11524:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   11525:                             my $uname = $by_id{$udom}{$id};
                   11526:                             $inst_response{$uname.':'.$udom} = $outcome;
                   11527:                         }
1.1226    raeburn  11528:                         if (ref($results) eq 'HASH') {
                   11529:                             foreach my $uname (keys(%{$results})) {
1.1227    raeburn  11530:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   11531:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   11532:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   11533:                                 }
1.1226    raeburn  11534:                             }
                   11535:                         }
                   11536:                     }
1.612     raeburn  11537:                 }
1.615     raeburn  11538:             } else {
1.1226    raeburn  11539:                 foreach my $udom (keys(%by_username)) {
                   11540:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   11541:                     if ($outcome eq 'ok') {
1.1227    raeburn  11542:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   11543:                             $inst_response{$uname.':'.$udom} = $outcome;
                   11544:                         }
1.1226    raeburn  11545:                         if (ref($results) eq 'HASH') {
                   11546:                             foreach my $uname (keys(%{$results})) {
                   11547:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   11548:                             }
                   11549:                         }
                   11550:                     }
                   11551:                 }
1.612     raeburn  11552:             }
1.1226    raeburn  11553:         } elsif (keys(%{$usershash}) == 1) {
                   11554:             my $user = (keys(%{$usershash}))[0];
                   11555:             my ($uname,$udom) = split(/:/,$user);
                   11556:             if (($udom ne '') && ($uname ne '')) {
                   11557:                 if (ref($usershash->{$user}) eq 'HASH') {
                   11558:                     if (ref($checks) eq 'HASH') {
                   11559:                         if (defined($checks->{'username'})) {
                   11560:                             ($inst_response{$user},%{$inst_results->{$user}}) = 
                   11561:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   11562:                         } elsif (defined($checks->{'id'})) {
                   11563:                             if ($usershash->{$user}->{'id'} ne '') {
                   11564:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   11565:                                     &Apache::lonnet::get_instuser($udom,undef,
                   11566:                                                                   $usershash->{$user}->{'id'});
                   11567:                             } else {
                   11568:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   11569:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   11570:                             }
1.585     raeburn  11571:                         }
1.1226    raeburn  11572:                     } else {
                   11573:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   11574:                             &Apache::lonnet::get_instuser($udom,$uname);
                   11575:                        return;
                   11576:                     }
                   11577:                     if (!$got_rules->{$udom}) {
                   11578:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   11579:                                                                  ['usercreation'],$udom);
                   11580:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   11581:                             foreach my $item ('username','id') {
                   11582:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   11583:                                    $$curr_rules{$udom}{$item} = 
                   11584:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   11585:                                 }
                   11586:                             }
                   11587:                         }
                   11588:                         $got_rules->{$udom} = 1;
1.585     raeburn  11589:                     }
                   11590:                 }
1.1226    raeburn  11591:             } else {
                   11592:                 return;
                   11593:             }
                   11594:         } else {
                   11595:             return;
                   11596:         }
                   11597:         foreach my $user (keys(%{$usershash})) {
                   11598:             my ($uname,$udom) = split(/:/,$user);
                   11599:             next if (($udom eq '') || ($uname eq ''));
                   11600:             my $id;
1.1227    raeburn  11601:             if (ref($inst_results) eq 'HASH') {
                   11602:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   11603:                     $id = $inst_results->{$user}->{'id'};
                   11604:                 }
                   11605:             }
                   11606:             if ($id eq '') { 
                   11607:                 if (ref($usershash->{$user})) {
                   11608:                     $id = $usershash->{$user}->{'id'};
                   11609:                 }
1.585     raeburn  11610:             }
1.612     raeburn  11611:             foreach my $item (keys(%{$checks})) {
                   11612:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   11613:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   11614:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226    raeburn  11615:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   11616:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  11617:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   11618:                                 if ($rule_check{$rule}) {
                   11619:                                     $$rulematch{$user}{$item} = $rule;
1.1226    raeburn  11620:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  11621:                                         if (ref($inst_results) eq 'HASH') {
                   11622:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   11623:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   11624:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1227    raeburn  11625:                                                 } elsif ($item eq 'id') {
                   11626:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   11627:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   11628:                                                     }
1.615     raeburn  11629:                                                 }
1.612     raeburn  11630:                                             }
                   11631:                                         }
1.615     raeburn  11632:                                     }
                   11633:                                     last;
1.585     raeburn  11634:                                 }
                   11635:                             }
                   11636:                         }
                   11637:                     }
                   11638:                 }
                   11639:             }
                   11640:         }
                   11641:     }
1.612     raeburn  11642:     return;
                   11643: }
                   11644: 
                   11645: sub user_rule_formats {
                   11646:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   11647:     my %text = ( 
                   11648:                  'username' => 'Usernames',
                   11649:                  'id'       => 'IDs',
                   11650:                );
                   11651:     my $output;
                   11652:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   11653:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   11654:         if (@{$ruleorder} > 0) {
1.1102    raeburn  11655:             $output = '<br />'.
                   11656:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   11657:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   11658:                       ' <ul>';
1.612     raeburn  11659:             foreach my $rule (@{$ruleorder}) {
                   11660:                 if (ref($curr_rules) eq 'ARRAY') {
                   11661:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   11662:                         if (ref($rules->{$rule}) eq 'HASH') {
                   11663:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   11664:                                         $rules->{$rule}{'desc'}.'</li>';
                   11665:                         }
                   11666:                     }
                   11667:                 }
                   11668:             }
                   11669:             $output .= '</ul>';
                   11670:         }
                   11671:     }
                   11672:     return $output;
                   11673: }
                   11674: 
                   11675: sub instrule_disallow_msg {
1.615     raeburn  11676:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  11677:     my $response;
                   11678:     my %text = (
                   11679:                   item   => 'username',
                   11680:                   items  => 'usernames',
                   11681:                   match  => 'matches',
                   11682:                   do     => 'does',
                   11683:                   action => 'a username',
                   11684:                   one    => 'one',
                   11685:                );
                   11686:     if ($count > 1) {
                   11687:         $text{'item'} = 'usernames';
                   11688:         $text{'match'} ='match';
                   11689:         $text{'do'} = 'do';
                   11690:         $text{'action'} = 'usernames',
                   11691:         $text{'one'} = 'ones';
                   11692:     }
                   11693:     if ($checkitem eq 'id') {
                   11694:         $text{'items'} = 'IDs';
                   11695:         $text{'item'} = 'ID';
                   11696:         $text{'action'} = 'an ID';
1.615     raeburn  11697:         if ($count > 1) {
                   11698:             $text{'item'} = 'IDs';
                   11699:             $text{'action'} = 'IDs';
                   11700:         }
1.612     raeburn  11701:     }
1.674     bisitz   11702:     $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  11703:     if ($mode eq 'upload') {
                   11704:         if ($checkitem eq 'username') {
                   11705:             $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'}.");
                   11706:         } elsif ($checkitem eq 'id') {
1.674     bisitz   11707:             $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  11708:         }
1.669     raeburn  11709:     } elsif ($mode eq 'selfcreate') {
                   11710:         if ($checkitem eq 'id') {
                   11711:             $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.");
                   11712:         }
1.615     raeburn  11713:     } else {
                   11714:         if ($checkitem eq 'username') {
                   11715:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   11716:         } elsif ($checkitem eq 'id') {
                   11717:             $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.");
                   11718:         }
1.612     raeburn  11719:     }
                   11720:     return $response;
1.585     raeburn  11721: }
                   11722: 
1.624     raeburn  11723: sub personal_data_fieldtitles {
                   11724:     my %fieldtitles = &Apache::lonlocal::texthash (
                   11725:                         id => 'Student/Employee ID',
                   11726:                         permanentemail => 'E-mail address',
                   11727:                         lastname => 'Last Name',
                   11728:                         firstname => 'First Name',
                   11729:                         middlename => 'Middle Name',
                   11730:                         generation => 'Generation',
                   11731:                         gen => 'Generation',
1.765     raeburn  11732:                         inststatus => 'Affiliation',
1.624     raeburn  11733:                    );
                   11734:     return %fieldtitles;
                   11735: }
                   11736: 
1.642     raeburn  11737: sub sorted_inst_types {
                   11738:     my ($dom) = @_;
1.1185    raeburn  11739:     my ($usertypes,$order);
                   11740:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   11741:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   11742:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   11743:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   11744:     } else {
                   11745:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   11746:     }
1.642     raeburn  11747:     my $othertitle = &mt('All users');
                   11748:     if ($env{'request.course.id'}) {
1.668     raeburn  11749:         $othertitle  = &mt('Any users');
1.642     raeburn  11750:     }
                   11751:     my @types;
                   11752:     if (ref($order) eq 'ARRAY') {
                   11753:         @types = @{$order};
                   11754:     }
                   11755:     if (@types == 0) {
                   11756:         if (ref($usertypes) eq 'HASH') {
                   11757:             @types = sort(keys(%{$usertypes}));
                   11758:         }
                   11759:     }
                   11760:     if (keys(%{$usertypes}) > 0) {
                   11761:         $othertitle = &mt('Other users');
                   11762:     }
                   11763:     return ($othertitle,$usertypes,\@types);
                   11764: }
                   11765: 
1.645     raeburn  11766: sub get_institutional_codes {
1.1361    raeburn  11767:     my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645     raeburn  11768: # Get complete list of course sections to update
                   11769:     my @currsections = ();
                   11770:     my @currxlists = ();
1.1361    raeburn  11771:     my (%unclutteredsec,%unclutteredlcsec);
1.645     raeburn  11772:     my $coursecode = $$settings{'internal.coursecode'};
1.1361    raeburn  11773:     my $crskey = $crs.':'.$coursecode;
                   11774:     @{$unclutteredsec{$crskey}} = ();
                   11775:     @{$unclutteredlcsec{$crskey}} = ();
1.645     raeburn  11776: 
                   11777:     if ($$settings{'internal.sectionnums'} ne '') {
                   11778:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   11779:     }
                   11780: 
                   11781:     if ($$settings{'internal.crosslistings'} ne '') {
                   11782:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   11783:     }
                   11784: 
                   11785:     if (@currxlists > 0) {
1.1361    raeburn  11786:         foreach my $xl (@currxlists) {
                   11787:             if ($xl =~ /^([^:]+):(\w*)$/) {
1.645     raeburn  11788:                 unless (grep/^$1$/,@{$allcourses}) {
1.1263    raeburn  11789:                     push(@{$allcourses},$1);
1.645     raeburn  11790:                     $$LC_code{$1} = $2;
                   11791:                 }
                   11792:             }
                   11793:         }
                   11794:     }
1.1361    raeburn  11795: 
1.645     raeburn  11796:     if (@currsections > 0) {
1.1361    raeburn  11797:         foreach my $sec (@currsections) {
                   11798:             if ($sec =~ m/^(\w+):(\w*)$/ ) {
                   11799:                 my $instsec = $1;
1.645     raeburn  11800:                 my $lc_sec = $2;
1.1361    raeburn  11801:                 unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
                   11802:                     push(@{$unclutteredsec{$crskey}},$instsec);
                   11803:                     push(@{$unclutteredlcsec{$crskey}},$lc_sec);
                   11804:                 }
                   11805:             }
                   11806:         }
                   11807:     }
                   11808: 
                   11809:     if (@{$unclutteredsec{$crskey}} > 0) {
                   11810:         my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
                   11811:         if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
                   11812:             for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
                   11813:                 my $sec = $coursecode.$formattedsec{$crskey}[$i];
                   11814:                 unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263    raeburn  11815:                     push(@{$allcourses},$sec);
1.1361    raeburn  11816:                     $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645     raeburn  11817:                 }
                   11818:             }
                   11819:         }
                   11820:     }
                   11821:     return;
                   11822: }
                   11823: 
1.971     raeburn  11824: sub get_standard_codeitems {
                   11825:     return ('Year','Semester','Department','Number','Section');
                   11826: }
                   11827: 
1.112     bowersj2 11828: =pod
                   11829: 
1.780     raeburn  11830: =head1 Slot Helpers
                   11831: 
                   11832: =over 4
                   11833: 
                   11834: =item * sorted_slots()
                   11835: 
1.1040    raeburn  11836: Sorts an array of slot names in order of an optional sort key,
                   11837: default sort is by slot start time (earliest first). 
1.780     raeburn  11838: 
                   11839: Inputs:
                   11840: 
                   11841: =over 4
                   11842: 
                   11843: slotsarr  - Reference to array of unsorted slot names.
                   11844: 
                   11845: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   11846: 
1.1040    raeburn  11847: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   11848: 
1.549     albertel 11849: =back
                   11850: 
1.780     raeburn  11851: Returns:
                   11852: 
                   11853: =over 4
                   11854: 
1.1040    raeburn  11855: sorted   - An array of slot names sorted by a specified sort key 
                   11856:            (default sort key is start time of the slot).
1.780     raeburn  11857: 
                   11858: =back
                   11859: 
                   11860: =cut
                   11861: 
                   11862: 
                   11863: sub sorted_slots {
1.1040    raeburn  11864:     my ($slotsarr,$slots,$sortkey) = @_;
                   11865:     if ($sortkey eq '') {
                   11866:         $sortkey = 'starttime';
                   11867:     }
1.780     raeburn  11868:     my @sorted;
                   11869:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   11870:         @sorted =
                   11871:             sort {
                   11872:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  11873:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  11874:                      }
                   11875:                      if (ref($slots->{$a})) { return -1;}
                   11876:                      if (ref($slots->{$b})) { return 1;}
                   11877:                      return 0;
                   11878:                  } @{$slotsarr};
                   11879:     }
                   11880:     return @sorted;
                   11881: }
                   11882: 
1.1040    raeburn  11883: =pod
                   11884: 
                   11885: =item * get_future_slots()
                   11886: 
                   11887: Inputs:
                   11888: 
                   11889: =over 4
                   11890: 
                   11891: cnum - course number
                   11892: 
                   11893: cdom - course domain
                   11894: 
                   11895: now - current UNIX time
                   11896: 
                   11897: symb - optional symb
                   11898: 
                   11899: =back
                   11900: 
                   11901: Returns:
                   11902: 
                   11903: =over 4
                   11904: 
                   11905: sorted_reservable - ref to array of student_schedulable slots currently 
                   11906:                     reservable, ordered by end date of reservation period.
                   11907: 
                   11908: reservable_now - ref to hash of student_schedulable slots currently
                   11909:                  reservable.
                   11910: 
                   11911:     Keys in inner hash are:
                   11912:     (a) symb: either blank or symb to which slot use is restricted.
1.1250    raeburn  11913:     (b) endreserve: end date of reservation period.
                   11914:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   11915:         selected.
1.1040    raeburn  11916: 
                   11917: sorted_future - ref to array of student_schedulable slots reservable in
                   11918:                 the future, ordered by start date of reservation period.
                   11919: 
                   11920: future_reservable - ref to hash of student_schedulable slots reservable
                   11921:                     in the future.
                   11922: 
                   11923:     Keys in inner hash are:
                   11924:     (a) symb: either blank or symb to which slot use is restricted.
1.1250    raeburn  11925:     (b) startreserve: start date of reservation period.
                   11926:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   11927:         selected.
1.1040    raeburn  11928: 
                   11929: =back
                   11930: 
                   11931: =cut
                   11932: 
                   11933: sub get_future_slots {
                   11934:     my ($cnum,$cdom,$now,$symb) = @_;
1.1229    raeburn  11935:     my $map;
                   11936:     if ($symb) {
                   11937:         ($map) = &Apache::lonnet::decode_symb($symb);
                   11938:     }
1.1040    raeburn  11939:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   11940:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   11941:     foreach my $slot (keys(%slots)) {
                   11942:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   11943:         if ($symb) {
1.1229    raeburn  11944:             if ($slots{$slot}->{'symb'} ne '') {
                   11945:                 my $canuse;
                   11946:                 my %oksymbs;
                   11947:                 my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   11948:                 map { $oksymbs{$_} = 1; } @slotsymbs;
                   11949:                 if ($oksymbs{$symb}) {
                   11950:                     $canuse = 1;
                   11951:                 } else {
                   11952:                     foreach my $item (@slotsymbs) {
                   11953:                         if ($item =~ /\.(page|sequence)$/) {
                   11954:                             (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                   11955:                             if (($map ne '') && ($map eq $sloturl)) {
                   11956:                                 $canuse = 1;
                   11957:                                 last;
                   11958:                             }
                   11959:                         }
                   11960:                     }
                   11961:                 }
                   11962:                 next unless ($canuse);
                   11963:             }
1.1040    raeburn  11964:         }
                   11965:         if (($slots{$slot}->{'starttime'} > $now) &&
                   11966:             ($slots{$slot}->{'endtime'} > $now)) {
                   11967:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   11968:                 my $userallowed = 0;
                   11969:                 if ($slots{$slot}->{'allowedsections'}) {
                   11970:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   11971:                     if (!defined($env{'request.role.sec'})
                   11972:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   11973:                         $userallowed=1;
                   11974:                     } else {
                   11975:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   11976:                             $userallowed=1;
                   11977:                         }
                   11978:                     }
                   11979:                     unless ($userallowed) {
                   11980:                         if (defined($env{'request.course.groups'})) {
                   11981:                             my @groups = split(/:/,$env{'request.course.groups'});
                   11982:                             foreach my $group (@groups) {
                   11983:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   11984:                                     $userallowed=1;
                   11985:                                     last;
                   11986:                                 }
                   11987:                             }
                   11988:                         }
                   11989:                     }
                   11990:                 }
                   11991:                 if ($slots{$slot}->{'allowedusers'}) {
                   11992:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   11993:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   11994:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   11995:                         $userallowed = 1;
                   11996:                     }
                   11997:                 }
                   11998:                 next unless($userallowed);
                   11999:             }
                   12000:             my $startreserve = $slots{$slot}->{'startreserve'};
                   12001:             my $endreserve = $slots{$slot}->{'endreserve'};
                   12002:             my $symb = $slots{$slot}->{'symb'};
1.1250    raeburn  12003:             my $uniqueperiod;
                   12004:             if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   12005:                 $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
                   12006:             }
1.1040    raeburn  12007:             if (($startreserve < $now) &&
                   12008:                 (!$endreserve || $endreserve > $now)) {
                   12009:                 my $lastres = $endreserve;
                   12010:                 if (!$lastres) {
                   12011:                     $lastres = $slots{$slot}->{'starttime'};
                   12012:                 }
                   12013:                 $reservable_now{$slot} = {
                   12014:                                            symb       => $symb,
1.1250    raeburn  12015:                                            endreserve => $lastres,
                   12016:                                            uniqueperiod => $uniqueperiod,
1.1040    raeburn  12017:                                          };
                   12018:             } elsif (($startreserve > $now) &&
                   12019:                      (!$endreserve || $endreserve > $startreserve)) {
                   12020:                 $future_reservable{$slot} = {
                   12021:                                               symb         => $symb,
1.1250    raeburn  12022:                                               startreserve => $startreserve,
                   12023:                                               uniqueperiod => $uniqueperiod,
1.1040    raeburn  12024:                                             };
                   12025:             }
                   12026:         }
                   12027:     }
                   12028:     my @unsorted_reservable = keys(%reservable_now);
                   12029:     if (@unsorted_reservable > 0) {
                   12030:         @sorted_reservable = 
                   12031:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   12032:     }
                   12033:     my @unsorted_future = keys(%future_reservable);
                   12034:     if (@unsorted_future > 0) {
                   12035:         @sorted_future =
                   12036:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   12037:     }
                   12038:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   12039: }
1.780     raeburn  12040: 
                   12041: =pod
                   12042: 
1.1057    foxr     12043: =back
                   12044: 
1.549     albertel 12045: =head1 HTTP Helpers
                   12046: 
                   12047: =over 4
                   12048: 
1.648     raeburn  12049: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 12050: 
1.258     albertel 12051: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 12052: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 12053: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 12054: 
                   12055: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   12056: $possible_names is an ref to an array of form element names.  As an example:
                   12057: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 12058: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 12059: 
                   12060: =cut
1.1       albertel 12061: 
1.6       albertel 12062: sub get_unprocessed_cgi {
1.25      albertel 12063:   my ($query,$possible_names)= @_;
1.26      matthew  12064:   # $Apache::lonxml::debug=1;
1.356     albertel 12065:   foreach my $pair (split(/&/,$query)) {
                   12066:     my ($name, $value) = split(/=/,$pair);
1.369     www      12067:     $name = &unescape($name);
1.25      albertel 12068:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   12069:       $value =~ tr/+/ /;
                   12070:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 12071:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 12072:     }
1.16      harris41 12073:   }
1.6       albertel 12074: }
                   12075: 
1.112     bowersj2 12076: =pod
                   12077: 
1.648     raeburn  12078: =item * &cacheheader() 
1.112     bowersj2 12079: 
                   12080: returns cache-controlling header code
                   12081: 
                   12082: =cut
                   12083: 
1.7       albertel 12084: sub cacheheader {
1.258     albertel 12085:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 12086:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   12087:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 12088:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   12089:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 12090:     return $output;
1.7       albertel 12091: }
                   12092: 
1.112     bowersj2 12093: =pod
                   12094: 
1.648     raeburn  12095: =item * &no_cache($r) 
1.112     bowersj2 12096: 
                   12097: specifies header code to not have cache
                   12098: 
                   12099: =cut
                   12100: 
1.9       albertel 12101: sub no_cache {
1.216     albertel 12102:     my ($r) = @_;
                   12103:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 12104: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 12105:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   12106:     $r->no_cache(1);
                   12107:     $r->header_out("Expires" => $date);
                   12108:     $r->header_out("Pragma" => "no-cache");
1.123     www      12109: }
                   12110: 
                   12111: sub content_type {
1.181     albertel 12112:     my ($r,$type,$charset) = @_;
1.299     foxr     12113:     if ($r) {
                   12114: 	#  Note that printout.pl calls this with undef for $r.
                   12115: 	&no_cache($r);
                   12116:     }
1.258     albertel 12117:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 12118:     unless ($charset) {
                   12119: 	$charset=&Apache::lonlocal::current_encoding;
                   12120:     }
                   12121:     if ($charset) { $type.='; charset='.$charset; }
                   12122:     if ($r) {
                   12123: 	$r->content_type($type);
                   12124:     } else {
                   12125: 	print("Content-type: $type\n\n");
                   12126:     }
1.9       albertel 12127: }
1.25      albertel 12128: 
1.112     bowersj2 12129: =pod
                   12130: 
1.648     raeburn  12131: =item * &add_to_env($name,$value) 
1.112     bowersj2 12132: 
1.258     albertel 12133: adds $name to the %env hash with value
1.112     bowersj2 12134: $value, if $name already exists, the entry is converted to an array
                   12135: reference and $value is added to the array.
                   12136: 
                   12137: =cut
                   12138: 
1.25      albertel 12139: sub add_to_env {
                   12140:   my ($name,$value)=@_;
1.258     albertel 12141:   if (defined($env{$name})) {
                   12142:     if (ref($env{$name})) {
1.25      albertel 12143:       #already have multiple values
1.258     albertel 12144:       push(@{ $env{$name} },$value);
1.25      albertel 12145:     } else {
                   12146:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 12147:       my $first=$env{$name};
                   12148:       undef($env{$name});
                   12149:       push(@{ $env{$name} },$first,$value);
1.25      albertel 12150:     }
                   12151:   } else {
1.258     albertel 12152:     $env{$name}=$value;
1.25      albertel 12153:   }
1.31      albertel 12154: }
1.149     albertel 12155: 
                   12156: =pod
                   12157: 
1.648     raeburn  12158: =item * &get_env_multiple($name) 
1.149     albertel 12159: 
1.258     albertel 12160: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 12161: values may be defined and end up as an array ref.
                   12162: 
                   12163: returns an array of values
                   12164: 
                   12165: =cut
                   12166: 
                   12167: sub get_env_multiple {
                   12168:     my ($name) = @_;
                   12169:     my @values;
1.258     albertel 12170:     if (defined($env{$name})) {
1.149     albertel 12171:         # exists is it an array
1.258     albertel 12172:         if (ref($env{$name})) {
                   12173:             @values=@{ $env{$name} };
1.149     albertel 12174:         } else {
1.258     albertel 12175:             $values[0]=$env{$name};
1.149     albertel 12176:         }
                   12177:     }
                   12178:     return(@values);
                   12179: }
                   12180: 
1.1249    damieng  12181: # Looks at given dependencies, and returns something depending on the context.
                   12182: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
                   12183: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
                   12184: # For all other contexts, returns ($output, $counter, $numpathchg).
                   12185: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
                   12186: # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
                   12187: # $numpathchg: integer with the number of cleaned up dependency paths.
                   12188: # \%existing: hash reference clean path -> 1 only for existing dependencies.
                   12189: # \%mapping: hash reference clean path -> original path for all dependencies.
                   12190: # @param {string} actionurl - The path to the handler, indicative of the context.
                   12191: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
                   12192: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
                   12193: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
                   12194: # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
                   12195: # @return {Array} - array depending on the context (not a reference)
1.660     raeburn  12196: sub ask_for_embedded_content {
1.1249    damieng  12197:     # NOTE: documentation was added afterwards, it could be wrong
1.660     raeburn  12198:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  12199:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  12200:         %currsubfile,%unused,$rem);
1.1071    raeburn  12201:     my $counter = 0;
                   12202:     my $numnew = 0;
1.987     raeburn  12203:     my $numremref = 0;
                   12204:     my $numinvalid = 0;
                   12205:     my $numpathchg = 0;
                   12206:     my $numexisting = 0;
1.1071    raeburn  12207:     my $numunused = 0;
                   12208:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  12209:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  12210:     my $heading = &mt('Upload embedded files');
                   12211:     my $buttontext = &mt('Upload');
                   12212: 
1.1249    damieng  12213:     # fills these variables based on the context:
                   12214:     # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
                   12215:     # $path, $fileloc, $title, $rem, $filename
1.1085    raeburn  12216:     if ($env{'request.course.id'}) {
1.1123    raeburn  12217:         if ($actionurl eq '/adm/dependencies') {
                   12218:             $navmap = Apache::lonnavmaps::navmap->new();
                   12219:         }
                   12220:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   12221:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  12222:     }
1.1123    raeburn  12223:     if (($actionurl eq '/adm/portfolio') || 
                   12224:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  12225:         my $current_path='/';
                   12226:         if ($env{'form.currentpath'}) {
                   12227:             $current_path = $env{'form.currentpath'};
                   12228:         }
                   12229:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  12230:             $udom = $cdom;
                   12231:             $uname = $cnum;
1.984     raeburn  12232:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   12233:         } else {
                   12234:             $udom = $env{'user.domain'};
                   12235:             $uname = $env{'user.name'};
                   12236:             $url = '/userfiles/portfolio';
                   12237:         }
1.987     raeburn  12238:         $toplevel = $url.'/';
1.984     raeburn  12239:         $url .= $current_path;
                   12240:         $getpropath = 1;
1.987     raeburn  12241:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   12242:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      12243:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  12244:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  12245:         $toplevel = $url;
1.984     raeburn  12246:         if ($rest ne '') {
1.987     raeburn  12247:             $url .= $rest;
                   12248:         }
                   12249:     } elsif ($actionurl eq '/adm/coursedocs') {
                   12250:         if (ref($args) eq 'HASH') {
1.1071    raeburn  12251:             $url = $args->{'docs_url'};
                   12252:             $toplevel = $url;
1.1084    raeburn  12253:             if ($args->{'context'} eq 'paste') {
                   12254:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   12255:                 ($path) = 
                   12256:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   12257:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   12258:                 $fileloc =~ s{^/}{};
                   12259:             }
1.1071    raeburn  12260:         }
1.1084    raeburn  12261:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  12262:         if ($env{'request.course.id'} ne '') {
                   12263:             if (ref($args) eq 'HASH') {
                   12264:                 $url = $args->{'docs_url'};
                   12265:                 $title = $args->{'docs_title'};
1.1126    raeburn  12266:                 $toplevel = $url; 
                   12267:                 unless ($toplevel =~ m{^/}) {
                   12268:                     $toplevel = "/$url";
                   12269:                 }
1.1085    raeburn  12270:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  12271:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   12272:                     $path = $1;
                   12273:                 } else {
                   12274:                     ($path) =
                   12275:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   12276:                 }
1.1195    raeburn  12277:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   12278:                     $fileloc = $toplevel;
                   12279:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   12280:                     my ($udom,$uname,$fname) =
                   12281:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   12282:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   12283:                 } else {
                   12284:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   12285:                 }
1.1071    raeburn  12286:                 $fileloc =~ s{^/}{};
                   12287:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   12288:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   12289:             }
1.987     raeburn  12290:         }
1.1123    raeburn  12291:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   12292:         $udom = $cdom;
                   12293:         $uname = $cnum;
                   12294:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   12295:         $toplevel = $url;
                   12296:         $path = $url;
                   12297:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   12298:         $fileloc =~ s{^/}{};
1.987     raeburn  12299:     }
1.1249    damieng  12300:     
                   12301:     # parses the dependency paths to get some info
                   12302:     # fills $newfiles, $mapping, $subdependencies, $dependencies
                   12303:     # $newfiles: hash URL -> 1 for new files or external URLs
                   12304:     # (will be completed later)
                   12305:     # $mapping:
                   12306:     #   for external URLs: external URL -> external URL
                   12307:     #   for relative paths: clean path -> original path
                   12308:     # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
                   12309:     # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126    raeburn  12310:     foreach my $file (keys(%{$allfiles})) {
                   12311:         my $embed_file;
                   12312:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   12313:             $embed_file = $1;
                   12314:         } else {
                   12315:             $embed_file = $file;
                   12316:         }
1.1158    raeburn  12317:         my ($absolutepath,$cleaned_file);
                   12318:         if ($embed_file =~ m{^\w+://}) {
                   12319:             $cleaned_file = $embed_file;
1.1147    raeburn  12320:             $newfiles{$cleaned_file} = 1;
                   12321:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  12322:         } else {
1.1158    raeburn  12323:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  12324:             if ($embed_file =~ m{^/}) {
                   12325:                 $absolutepath = $embed_file;
                   12326:             }
1.1147    raeburn  12327:             if ($cleaned_file =~ m{/}) {
                   12328:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  12329:                 $path = &check_for_traversal($path,$url,$toplevel);
                   12330:                 my $item = $fname;
                   12331:                 if ($path ne '') {
                   12332:                     $item = $path.'/'.$fname;
                   12333:                     $subdependencies{$path}{$fname} = 1;
                   12334:                 } else {
                   12335:                     $dependencies{$item} = 1;
                   12336:                 }
                   12337:                 if ($absolutepath) {
                   12338:                     $mapping{$item} = $absolutepath;
                   12339:                 } else {
                   12340:                     $mapping{$item} = $embed_file;
                   12341:                 }
                   12342:             } else {
                   12343:                 $dependencies{$embed_file} = 1;
                   12344:                 if ($absolutepath) {
1.1147    raeburn  12345:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  12346:                 } else {
1.1147    raeburn  12347:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  12348:                 }
                   12349:             }
1.984     raeburn  12350:         }
                   12351:     }
1.1249    damieng  12352:     
                   12353:     # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
                   12354:     # and lists
                   12355:     # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
                   12356:     # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
                   12357:     # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
                   12358:     #                                    the path had to be cleaned up
                   12359:     # $existing: hash clean path -> 1 if the file exists
                   12360:     # $numexisting: number of keys in $existing
                   12361:     # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
                   12362:     # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
                   12363:     #                                      dependency subdirectories that are
                   12364:     #                                      not listed as dependencies, with some exceptions using $rem
1.1071    raeburn  12365:     my $dirptr = 16384;
1.984     raeburn  12366:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  12367:         $currsubfile{$path} = {};
1.1123    raeburn  12368:         if (($actionurl eq '/adm/portfolio') || 
                   12369:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  12370:             my ($sublistref,$listerror) =
                   12371:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   12372:             if (ref($sublistref) eq 'ARRAY') {
                   12373:                 foreach my $line (@{$sublistref}) {
                   12374:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  12375:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  12376:                 }
1.984     raeburn  12377:             }
1.987     raeburn  12378:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  12379:             if (opendir(my $dir,$url.'/'.$path)) {
                   12380:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  12381:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   12382:             }
1.1084    raeburn  12383:         } elsif (($actionurl eq '/adm/dependencies') ||
                   12384:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  12385:                   ($args->{'context'} eq 'paste')) ||
                   12386:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  12387:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  12388:                 my $dir;
                   12389:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   12390:                     $dir = $fileloc;
                   12391:                 } else {
                   12392:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   12393:                 }
1.1071    raeburn  12394:                 if ($dir ne '') {
                   12395:                     my ($sublistref,$listerror) =
                   12396:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   12397:                     if (ref($sublistref) eq 'ARRAY') {
                   12398:                         foreach my $line (@{$sublistref}) {
                   12399:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   12400:                                 undef,$mtime)=split(/\&/,$line,12);
                   12401:                             unless (($testdir&$dirptr) ||
                   12402:                                     ($file_name =~ /^\.\.?$/)) {
                   12403:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   12404:                             }
                   12405:                         }
                   12406:                     }
                   12407:                 }
1.984     raeburn  12408:             }
                   12409:         }
                   12410:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  12411:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  12412:                 my $item = $path.'/'.$file;
                   12413:                 unless ($mapping{$item} eq $item) {
                   12414:                     $pathchanges{$item} = 1;
                   12415:                 }
                   12416:                 $existing{$item} = 1;
                   12417:                 $numexisting ++;
                   12418:             } else {
                   12419:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  12420:             }
                   12421:         }
1.1071    raeburn  12422:         if ($actionurl eq '/adm/dependencies') {
                   12423:             foreach my $path (keys(%currsubfile)) {
                   12424:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   12425:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   12426:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  12427:                              next if (($rem ne '') &&
                   12428:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   12429:                                        (ref($navmap) &&
                   12430:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   12431:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   12432:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  12433:                              $unused{$path.'/'.$file} = 1; 
                   12434:                          }
                   12435:                     }
                   12436:                 }
                   12437:             }
                   12438:         }
1.984     raeburn  12439:     }
1.1249    damieng  12440:     
                   12441:     # fills $currfile, hash file name -> 1 or [$size,$mtime]
                   12442:     # for files in $url or $fileloc (target directory) in some contexts
1.987     raeburn  12443:     my %currfile;
1.1123    raeburn  12444:     if (($actionurl eq '/adm/portfolio') ||
                   12445:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  12446:         my ($dirlistref,$listerror) =
                   12447:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   12448:         if (ref($dirlistref) eq 'ARRAY') {
                   12449:             foreach my $line (@{$dirlistref}) {
                   12450:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   12451:                 $currfile{$file_name} = 1;
                   12452:             }
1.984     raeburn  12453:         }
1.987     raeburn  12454:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  12455:         if (opendir(my $dir,$url)) {
1.987     raeburn  12456:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  12457:             map {$currfile{$_} = 1;} @dir_list;
                   12458:         }
1.1084    raeburn  12459:     } elsif (($actionurl eq '/adm/dependencies') ||
                   12460:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  12461:               ($args->{'context'} eq 'paste')) ||
                   12462:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  12463:         if ($env{'request.course.id'} ne '') {
                   12464:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   12465:             if ($dir ne '') {
                   12466:                 my ($dirlistref,$listerror) =
                   12467:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   12468:                 if (ref($dirlistref) eq 'ARRAY') {
                   12469:                     foreach my $line (@{$dirlistref}) {
                   12470:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   12471:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   12472:                         unless (($testdir&$dirptr) ||
                   12473:                                 ($file_name =~ /^\.\.?$/)) {
                   12474:                             $currfile{$file_name} = [$size,$mtime];
                   12475:                         }
                   12476:                     }
                   12477:                 }
                   12478:             }
                   12479:         }
1.984     raeburn  12480:     }
1.1249    damieng  12481:     # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
                   12482:     # are not in subdirectories, using $currfile
1.984     raeburn  12483:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  12484:         if (exists($currfile{$file})) {
1.987     raeburn  12485:             unless ($mapping{$file} eq $file) {
                   12486:                 $pathchanges{$file} = 1;
                   12487:             }
                   12488:             $existing{$file} = 1;
                   12489:             $numexisting ++;
                   12490:         } else {
1.984     raeburn  12491:             $newfiles{$file} = 1;
                   12492:         }
                   12493:     }
1.1071    raeburn  12494:     foreach my $file (keys(%currfile)) {
                   12495:         unless (($file eq $filename) ||
                   12496:                 ($file eq $filename.'.bak') ||
                   12497:                 ($dependencies{$file})) {
1.1085    raeburn  12498:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  12499:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   12500:                     next if (($rem ne '') &&
                   12501:                              (($env{"httpref.$rem".$file} ne '') ||
                   12502:                               (ref($navmap) &&
                   12503:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   12504:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   12505:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   12506:                 }
1.1085    raeburn  12507:             }
1.1071    raeburn  12508:             $unused{$file} = 1;
                   12509:         }
                   12510:     }
1.1249    damieng  12511:     
                   12512:     # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084    raeburn  12513:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   12514:         ($args->{'context'} eq 'paste')) {
                   12515:         $counter = scalar(keys(%existing));
                   12516:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  12517:         return ($output,$counter,$numpathchg,\%existing);
                   12518:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   12519:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   12520:         $counter = scalar(keys(%existing));
                   12521:         $numpathchg = scalar(keys(%pathchanges));
                   12522:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  12523:     }
1.1249    damieng  12524:     
                   12525:     # returns HTML otherwise, with dependency results and to ask for more uploads
                   12526:     
                   12527:     # $upload_output: missing dependencies (with upload form)
                   12528:     # $modify_output: uploaded dependencies (in use)
                   12529:     # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984     raeburn  12530:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  12531:         if ($actionurl eq '/adm/dependencies') {
                   12532:             next if ($embed_file =~ m{^\w+://});
                   12533:         }
1.660     raeburn  12534:         $upload_output .= &start_data_table_row().
1.1123    raeburn  12535:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  12536:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  12537:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  12538:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   12539:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  12540:         }
1.1123    raeburn  12541:         $upload_output .= '</td>';
1.1071    raeburn  12542:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  12543:             $upload_output.='<td align="right">'.
                   12544:                             '<span class="LC_info LC_fontsize_medium">'.
                   12545:                             &mt("URL points to web address").'</span>';
1.987     raeburn  12546:             $numremref++;
1.660     raeburn  12547:         } elsif ($args->{'error_on_invalid_names'}
                   12548:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  12549:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   12550:                             &mt('Invalid characters').'</span>';
1.987     raeburn  12551:             $numinvalid++;
1.660     raeburn  12552:         } else {
1.1123    raeburn  12553:             $upload_output .= '<td>'.
                   12554:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  12555:                                                      $embed_file,\%mapping,
1.1071    raeburn  12556:                                                      $allfiles,$codebase,'upload');
                   12557:             $counter ++;
                   12558:             $numnew ++;
1.987     raeburn  12559:         }
                   12560:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   12561:     }
                   12562:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  12563:         if ($actionurl eq '/adm/dependencies') {
                   12564:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   12565:             $modify_output .= &start_data_table_row().
                   12566:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   12567:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   12568:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   12569:                               '<td>'.$size.'</td>'.
                   12570:                               '<td>'.$mtime.'</td>'.
                   12571:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   12572:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   12573:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   12574:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   12575:                               &embedded_file_element('upload_embedded',$counter,
                   12576:                                                      $embed_file,\%mapping,
                   12577:                                                      $allfiles,$codebase,'modify').
                   12578:                               '</div></td>'.
                   12579:                               &end_data_table_row()."\n";
                   12580:             $counter ++;
                   12581:         } else {
                   12582:             $upload_output .= &start_data_table_row().
1.1123    raeburn  12583:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   12584:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   12585:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  12586:                               &Apache::loncommon::end_data_table_row()."\n";
                   12587:         }
                   12588:     }
                   12589:     my $delidx = $counter;
                   12590:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   12591:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   12592:         $delete_output .= &start_data_table_row().
                   12593:                           '<td><img src="'.&icon($oldfile).'" />'.
                   12594:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   12595:                           '<td>'.$size.'</td>'.
                   12596:                           '<td>'.$mtime.'</td>'.
                   12597:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   12598:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   12599:                           &embedded_file_element('upload_embedded',$delidx,
                   12600:                                                  $oldfile,\%mapping,$allfiles,
                   12601:                                                  $codebase,'delete').'</td>'.
                   12602:                           &end_data_table_row()."\n"; 
                   12603:         $numunused ++;
                   12604:         $delidx ++;
1.987     raeburn  12605:     }
                   12606:     if ($upload_output) {
                   12607:         $upload_output = &start_data_table().
                   12608:                          $upload_output.
                   12609:                          &end_data_table()."\n";
                   12610:     }
1.1071    raeburn  12611:     if ($modify_output) {
                   12612:         $modify_output = &start_data_table().
                   12613:                          &start_data_table_header_row().
                   12614:                          '<th>'.&mt('File').'</th>'.
                   12615:                          '<th>'.&mt('Size (KB)').'</th>'.
                   12616:                          '<th>'.&mt('Modified').'</th>'.
                   12617:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   12618:                          &end_data_table_header_row().
                   12619:                          $modify_output.
                   12620:                          &end_data_table()."\n";
                   12621:     }
                   12622:     if ($delete_output) {
                   12623:         $delete_output = &start_data_table().
                   12624:                          &start_data_table_header_row().
                   12625:                          '<th>'.&mt('File').'</th>'.
                   12626:                          '<th>'.&mt('Size (KB)').'</th>'.
                   12627:                          '<th>'.&mt('Modified').'</th>'.
                   12628:                          '<th>'.&mt('Delete?').'</th>'.
                   12629:                          &end_data_table_header_row().
                   12630:                          $delete_output.
                   12631:                          &end_data_table()."\n";
                   12632:     }
1.987     raeburn  12633:     my $applies = 0;
                   12634:     if ($numremref) {
                   12635:         $applies ++;
                   12636:     }
                   12637:     if ($numinvalid) {
                   12638:         $applies ++;
                   12639:     }
                   12640:     if ($numexisting) {
                   12641:         $applies ++;
                   12642:     }
1.1071    raeburn  12643:     if ($counter || $numunused) {
1.987     raeburn  12644:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   12645:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  12646:                   $state.'<h3>'.$heading.'</h3>'; 
                   12647:         if ($actionurl eq '/adm/dependencies') {
                   12648:             if ($numnew) {
                   12649:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   12650:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   12651:                            $upload_output.'<br />'."\n";
                   12652:             }
                   12653:             if ($numexisting) {
                   12654:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   12655:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   12656:                            $modify_output.'<br />'."\n";
                   12657:                            $buttontext = &mt('Save changes');
                   12658:             }
                   12659:             if ($numunused) {
                   12660:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   12661:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   12662:                            $delete_output.'<br />'."\n";
                   12663:                            $buttontext = &mt('Save changes');
                   12664:             }
                   12665:         } else {
                   12666:             $output .= $upload_output.'<br />'."\n";
                   12667:         }
                   12668:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   12669:                    $counter.'" />'."\n";
                   12670:         if ($actionurl eq '/adm/dependencies') { 
                   12671:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   12672:                        $numnew.'" />'."\n";
                   12673:         } elsif ($actionurl eq '') {
1.987     raeburn  12674:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   12675:         }
                   12676:     } elsif ($applies) {
                   12677:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   12678:         if ($applies > 1) {
                   12679:             $output .=  
1.1123    raeburn  12680:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  12681:             if ($numremref) {
                   12682:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   12683:             }
                   12684:             if ($numinvalid) {
                   12685:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   12686:             }
                   12687:             if ($numexisting) {
                   12688:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   12689:             }
                   12690:             $output .= '</ul><br />';
                   12691:         } elsif ($numremref) {
                   12692:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   12693:         } elsif ($numinvalid) {
                   12694:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   12695:         } elsif ($numexisting) {
                   12696:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   12697:         }
                   12698:         $output .= $upload_output.'<br />';
                   12699:     }
                   12700:     my ($pathchange_output,$chgcount);
1.1071    raeburn  12701:     $chgcount = $counter;
1.987     raeburn  12702:     if (keys(%pathchanges) > 0) {
                   12703:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  12704:             if ($counter) {
1.987     raeburn  12705:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   12706:                                                   $embed_file,\%mapping,
1.1071    raeburn  12707:                                                   $allfiles,$codebase,'change');
1.987     raeburn  12708:             } else {
                   12709:                 $pathchange_output .= 
                   12710:                     &start_data_table_row().
                   12711:                     '<td><input type ="checkbox" name="namechange" value="'.
                   12712:                     $chgcount.'" checked="checked" /></td>'.
                   12713:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   12714:                     '<td>'.$embed_file.
                   12715:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  12716:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  12717:                     '</td>'.&end_data_table_row();
1.660     raeburn  12718:             }
1.987     raeburn  12719:             $numpathchg ++;
                   12720:             $chgcount ++;
1.660     raeburn  12721:         }
                   12722:     }
1.1127    raeburn  12723:     if (($counter) || ($numunused)) {
1.987     raeburn  12724:         if ($numpathchg) {
                   12725:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   12726:                        $numpathchg.'" />'."\n";
                   12727:         }
                   12728:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   12729:             ($actionurl eq '/adm/imsimport')) {
                   12730:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   12731:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   12732:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  12733:         } elsif ($actionurl eq '/adm/dependencies') {
                   12734:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  12735:         }
1.1123    raeburn  12736:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  12737:     } elsif ($numpathchg) {
                   12738:         my %pathchange = ();
                   12739:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   12740:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   12741:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  12742:         }
1.987     raeburn  12743:     }
1.1071    raeburn  12744:     return ($output,$counter,$numpathchg);
1.987     raeburn  12745: }
                   12746: 
1.1147    raeburn  12747: =pod
                   12748: 
                   12749: =item * clean_path($name)
                   12750: 
                   12751: Performs clean-up of directories, subdirectories and filename in an
                   12752: embedded object, referenced in an HTML file which is being uploaded
                   12753: to a course or portfolio, where 
                   12754: "Upload embedded images/multimedia files if HTML file" checkbox was
                   12755: checked.
                   12756: 
                   12757: Clean-up is similar to replacements in lonnet::clean_filename()
                   12758: except each / between sub-directory and next level is preserved.
                   12759: 
                   12760: =cut
                   12761: 
                   12762: sub clean_path {
                   12763:     my ($embed_file) = @_;
                   12764:     $embed_file =~s{^/+}{};
                   12765:     my @contents;
                   12766:     if ($embed_file =~ m{/}) {
                   12767:         @contents = split(/\//,$embed_file);
                   12768:     } else {
                   12769:         @contents = ($embed_file);
                   12770:     }
                   12771:     my $lastidx = scalar(@contents)-1;
                   12772:     for (my $i=0; $i<=$lastidx; $i++) { 
                   12773:         $contents[$i]=~s{\\}{/}g;
                   12774:         $contents[$i]=~s/\s+/\_/g;
                   12775:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   12776:         if ($i == $lastidx) {
                   12777:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   12778:         }
                   12779:     }
                   12780:     if ($lastidx > 0) {
                   12781:         return join('/',@contents);
                   12782:     } else {
                   12783:         return $contents[0];
                   12784:     }
                   12785: }
                   12786: 
1.987     raeburn  12787: sub embedded_file_element {
1.1071    raeburn  12788:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  12789:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   12790:                    (ref($codebase) eq 'HASH'));
                   12791:     my $output;
1.1071    raeburn  12792:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  12793:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   12794:     }
                   12795:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   12796:                &escape($embed_file).'" />';
                   12797:     unless (($context eq 'upload_embedded') && 
                   12798:             ($mapping->{$embed_file} eq $embed_file)) {
                   12799:         $output .='
                   12800:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   12801:     }
                   12802:     my $attrib;
                   12803:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   12804:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   12805:     }
                   12806:     $output .=
                   12807:         "\n\t\t".
                   12808:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   12809:         $attrib.'" />';
                   12810:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   12811:         $output .=
                   12812:             "\n\t\t".
                   12813:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   12814:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  12815:     }
1.987     raeburn  12816:     return $output;
1.660     raeburn  12817: }
                   12818: 
1.1071    raeburn  12819: sub get_dependency_details {
                   12820:     my ($currfile,$currsubfile,$embed_file) = @_;
                   12821:     my ($size,$mtime,$showsize,$showmtime);
                   12822:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   12823:         if ($embed_file =~ m{/}) {
                   12824:             my ($path,$fname) = split(/\//,$embed_file);
                   12825:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   12826:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   12827:             }
                   12828:         } else {
                   12829:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   12830:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   12831:             }
                   12832:         }
                   12833:         $showsize = $size/1024.0;
                   12834:         $showsize = sprintf("%.1f",$showsize);
                   12835:         if ($mtime > 0) {
                   12836:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   12837:         }
                   12838:     }
                   12839:     return ($showsize,$showmtime);
                   12840: }
                   12841: 
                   12842: sub ask_embedded_js {
                   12843:     return <<"END";
                   12844: <script type="text/javascript"">
                   12845: // <![CDATA[
                   12846: function toggleBrowse(counter) {
                   12847:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   12848:     var fileid = document.getElementById('embedded_item_'+counter);
                   12849:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   12850:     if (chkboxid.checked == true) {
                   12851:         uploaddivid.style.display='block';
                   12852:     } else {
                   12853:         uploaddivid.style.display='none';
                   12854:         fileid.value = '';
                   12855:     }
                   12856: }
                   12857: // ]]>
                   12858: </script>
                   12859: 
                   12860: END
                   12861: }
                   12862: 
1.661     raeburn  12863: sub upload_embedded {
                   12864:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  12865:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   12866:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  12867:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   12868:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   12869:         my $orig_uploaded_filename =
                   12870:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  12871:         foreach my $type ('orig','ref','attrib','codebase') {
                   12872:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   12873:                 $env{'form.embedded_'.$type.'_'.$i} =
                   12874:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   12875:             }
                   12876:         }
1.661     raeburn  12877:         my ($path,$fname) =
                   12878:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   12879:         # no path, whole string is fname
                   12880:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   12881:         $fname = &Apache::lonnet::clean_filename($fname);
                   12882:         # See if there is anything left
                   12883:         next if ($fname eq '');
                   12884: 
                   12885:         # Check if file already exists as a file or directory.
                   12886:         my ($state,$msg);
                   12887:         if ($context eq 'portfolio') {
                   12888:             my $port_path = $dirpath;
                   12889:             if ($group ne '') {
                   12890:                 $port_path = "groups/$group/$port_path";
                   12891:             }
1.987     raeburn  12892:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   12893:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  12894:                                               $dir_root,$port_path,$disk_quota,
                   12895:                                               $current_disk_usage,$uname,$udom);
                   12896:             if ($state eq 'will_exceed_quota'
1.984     raeburn  12897:                 || $state eq 'file_locked') {
1.661     raeburn  12898:                 $output .= $msg;
                   12899:                 next;
                   12900:             }
                   12901:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   12902:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   12903:             if ($state eq 'exists') {
                   12904:                 $output .= $msg;
                   12905:                 next;
                   12906:             }
                   12907:         }
                   12908:         # Check if extension is valid
                   12909:         if (($fname =~ /\.(\w+)$/) &&
                   12910:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   12911:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   12912:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  12913:             next;
                   12914:         } elsif (($fname =~ /\.(\w+)$/) &&
                   12915:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  12916:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  12917:             next;
                   12918:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   12919:             $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  12920:             next;
                   12921:         }
                   12922:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  12923:         my $subdir = $path;
                   12924:         $subdir =~ s{/+$}{};
1.661     raeburn  12925:         if ($context eq 'portfolio') {
1.984     raeburn  12926:             my $result;
                   12927:             if ($state eq 'existingfile') {
                   12928:                 $result=
                   12929:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  12930:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  12931:             } else {
1.984     raeburn  12932:                 $result=
                   12933:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  12934:                                                     $dirpath.
1.1123    raeburn  12935:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  12936:                 if ($result !~ m|^/uploaded/|) {
                   12937:                     $output .= '<span class="LC_error">'
                   12938:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   12939:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   12940:                                .'</span><br />';
                   12941:                     next;
                   12942:                 } else {
1.987     raeburn  12943:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   12944:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  12945:                 }
1.661     raeburn  12946:             }
1.1123    raeburn  12947:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  12948:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   12949:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  12950:             my $result =
1.1126    raeburn  12951:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  12952:             if ($result !~ m|^/uploaded/|) {
                   12953:                 $output .= '<span class="LC_error">'
                   12954:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   12955:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   12956:                            .'</span><br />';
                   12957:                     next;
                   12958:             } else {
                   12959:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   12960:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  12961:                 if ($context eq 'syllabus') {
                   12962:                     &Apache::lonnet::make_public_indefinitely($result);
                   12963:                 }
1.987     raeburn  12964:             }
1.661     raeburn  12965:         } else {
                   12966: # Save the file
                   12967:             my $target = $env{'form.embedded_item_'.$i};
                   12968:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   12969:             my $dest = $fullpath.$fname;
                   12970:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  12971:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  12972:             my $count;
                   12973:             my $filepath = $dir_root;
1.1027    raeburn  12974:             foreach my $subdir (@parts) {
                   12975:                 $filepath .= "/$subdir";
                   12976:                 if (!-e $filepath) {
1.661     raeburn  12977:                     mkdir($filepath,0770);
                   12978:                 }
                   12979:             }
                   12980:             my $fh;
                   12981:             if (!open($fh,'>'.$dest)) {
                   12982:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   12983:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  12984:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   12985:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  12986:                            '</span><br />';
                   12987:             } else {
                   12988:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   12989:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   12990:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  12991:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   12992:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  12993:                               '</span><br />';
                   12994:                 } else {
1.987     raeburn  12995:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   12996:                                $url.'</span>').'<br />';
                   12997:                     unless ($context eq 'testbank') {
                   12998:                         $footer .= &mt('View embedded file: [_1]',
                   12999:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   13000:                     }
                   13001:                 }
                   13002:                 close($fh);
                   13003:             }
                   13004:         }
                   13005:         if ($env{'form.embedded_ref_'.$i}) {
                   13006:             $pathchange{$i} = 1;
                   13007:         }
                   13008:     }
                   13009:     if ($output) {
                   13010:         $output = '<p>'.$output.'</p>';
                   13011:     }
                   13012:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   13013:     $returnflag = 'ok';
1.1071    raeburn  13014:     my $numpathchgs = scalar(keys(%pathchange));
                   13015:     if ($numpathchgs > 0) {
1.987     raeburn  13016:         if ($context eq 'portfolio') {
                   13017:             $output .= '<p>'.&mt('or').'</p>';
                   13018:         } elsif ($context eq 'testbank') {
1.1071    raeburn  13019:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   13020:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  13021:             $returnflag = 'modify_orightml';
                   13022:         }
                   13023:     }
1.1071    raeburn  13024:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  13025: }
                   13026: 
                   13027: sub modify_html_form {
                   13028:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   13029:     my $end = 0;
                   13030:     my $modifyform;
                   13031:     if ($context eq 'upload_embedded') {
                   13032:         return unless (ref($pathchange) eq 'HASH');
                   13033:         if ($env{'form.number_embedded_items'}) {
                   13034:             $end += $env{'form.number_embedded_items'};
                   13035:         }
                   13036:         if ($env{'form.number_pathchange_items'}) {
                   13037:             $end += $env{'form.number_pathchange_items'};
                   13038:         }
                   13039:         if ($end) {
                   13040:             for (my $i=0; $i<$end; $i++) {
                   13041:                 if ($i < $env{'form.number_embedded_items'}) {
                   13042:                     next unless($pathchange->{$i});
                   13043:                 }
                   13044:                 $modifyform .=
                   13045:                     &start_data_table_row().
                   13046:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   13047:                     'checked="checked" /></td>'.
                   13048:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   13049:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   13050:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   13051:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   13052:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   13053:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   13054:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   13055:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   13056:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   13057:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   13058:                     &end_data_table_row();
1.1071    raeburn  13059:             }
1.987     raeburn  13060:         }
                   13061:     } else {
                   13062:         $modifyform = $pathchgtable;
                   13063:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   13064:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   13065:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   13066:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   13067:         }
                   13068:     }
                   13069:     if ($modifyform) {
1.1071    raeburn  13070:         if ($actionurl eq '/adm/dependencies') {
                   13071:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   13072:         }
1.987     raeburn  13073:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   13074:                '<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".
                   13075:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   13076:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   13077:                '</ol></p>'."\n".'<p>'.
                   13078:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   13079:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   13080:                &start_data_table()."\n".
                   13081:                &start_data_table_header_row().
                   13082:                '<th>'.&mt('Change?').'</th>'.
                   13083:                '<th>'.&mt('Current reference').'</th>'.
                   13084:                '<th>'.&mt('Required reference').'</th>'.
                   13085:                &end_data_table_header_row()."\n".
                   13086:                $modifyform.
                   13087:                &end_data_table().'<br />'."\n".$hiddenstate.
                   13088:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   13089:                '</form>'."\n";
                   13090:     }
                   13091:     return;
                   13092: }
                   13093: 
                   13094: sub modify_html_refs {
1.1123    raeburn  13095:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  13096:     my $container;
                   13097:     if ($context eq 'portfolio') {
                   13098:         $container = $env{'form.container'};
                   13099:     } elsif ($context eq 'coursedoc') {
                   13100:         $container = $env{'form.primaryurl'};
1.1071    raeburn  13101:     } elsif ($context eq 'manage_dependencies') {
                   13102:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   13103:         $container = "/$container";
1.1123    raeburn  13104:     } elsif ($context eq 'syllabus') {
                   13105:         $container = $url;
1.987     raeburn  13106:     } else {
1.1027    raeburn  13107:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  13108:     }
                   13109:     my (%allfiles,%codebase,$output,$content);
                   13110:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  13111:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  13112:         if (wantarray) {
                   13113:             return ('',0,0); 
                   13114:         } else {
                   13115:             return;
                   13116:         }
                   13117:     }
                   13118:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  13119:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  13120:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   13121:             if (wantarray) {
                   13122:                 return ('',0,0);
                   13123:             } else {
                   13124:                 return;
                   13125:             }
                   13126:         } 
1.987     raeburn  13127:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  13128:         if ($content eq '-1') {
                   13129:             if (wantarray) {
                   13130:                 return ('',0,0);
                   13131:             } else {
                   13132:                 return;
                   13133:             }
                   13134:         }
1.987     raeburn  13135:     } else {
1.1071    raeburn  13136:         unless ($container =~ /^\Q$dir_root\E/) {
                   13137:             if (wantarray) {
                   13138:                 return ('',0,0);
                   13139:             } else {
                   13140:                 return;
                   13141:             }
                   13142:         } 
1.1317    raeburn  13143:         if (open(my $fh,'<',$container)) {
1.987     raeburn  13144:             $content = join('', <$fh>);
                   13145:             close($fh);
                   13146:         } else {
1.1071    raeburn  13147:             if (wantarray) {
                   13148:                 return ('',0,0);
                   13149:             } else {
                   13150:                 return;
                   13151:             }
1.987     raeburn  13152:         }
                   13153:     }
                   13154:     my ($count,$codebasecount) = (0,0);
                   13155:     my $mm = new File::MMagic;
                   13156:     my $mime_type = $mm->checktype_contents($content);
                   13157:     if ($mime_type eq 'text/html') {
                   13158:         my $parse_result = 
                   13159:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   13160:                                                     \%codebase,\$content);
                   13161:         if ($parse_result eq 'ok') {
                   13162:             foreach my $i (@changes) {
                   13163:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   13164:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   13165:                 if ($allfiles{$ref}) {
                   13166:                     my $newname =  $orig;
                   13167:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  13168:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  13169:                     if ($attrib_regexp =~ /:/) {
                   13170:                         $attrib_regexp =~ s/\:/|/g;
                   13171:                     }
                   13172:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   13173:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   13174:                         $count += $numchg;
1.1123    raeburn  13175:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  13176:                         delete($allfiles{$ref});
1.987     raeburn  13177:                     }
                   13178:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  13179:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  13180:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   13181:                         $codebasecount ++;
                   13182:                     }
                   13183:                 }
                   13184:             }
1.1123    raeburn  13185:             my $skiprewrites;
1.987     raeburn  13186:             if ($count || $codebasecount) {
                   13187:                 my $saveresult;
1.1071    raeburn  13188:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  13189:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  13190:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   13191:                     if ($url eq $container) {
                   13192:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   13193:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   13194:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  13195:                                             $fname.'</span>').'</p>';
1.987     raeburn  13196:                     } else {
                   13197:                          $output = '<p class="LC_error">'.
                   13198:                                    &mt('Error: update failed for: [_1].',
                   13199:                                    '<span class="LC_filename">'.
                   13200:                                    $container.'</span>').'</p>';
                   13201:                     }
1.1123    raeburn  13202:                     if ($context eq 'syllabus') {
                   13203:                         unless ($saveresult eq 'ok') {
                   13204:                             $skiprewrites = 1;
                   13205:                         }
                   13206:                     }
1.987     raeburn  13207:                 } else {
1.1317    raeburn  13208:                     if (open(my $fh,'>',$container)) {
1.987     raeburn  13209:                         print $fh $content;
                   13210:                         close($fh);
                   13211:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   13212:                                   $count,'<span class="LC_filename">'.
                   13213:                                   $container.'</span>').'</p>';
1.661     raeburn  13214:                     } else {
1.987     raeburn  13215:                          $output = '<p class="LC_error">'.
                   13216:                                    &mt('Error: could not update [_1].',
                   13217:                                    '<span class="LC_filename">'.
                   13218:                                    $container.'</span>').'</p>';
1.661     raeburn  13219:                     }
                   13220:                 }
                   13221:             }
1.1123    raeburn  13222:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   13223:                 my ($actionurl,$state);
                   13224:                 $actionurl = "/public/$udom/$uname/syllabus";
                   13225:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   13226:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   13227:                                               \%codebase,
                   13228:                                               {'context' => 'rewrites',
                   13229:                                                'ignore_remote_references' => 1,});
                   13230:                 if (ref($mapping) eq 'HASH') {
                   13231:                     my $rewrites = 0;
                   13232:                     foreach my $key (keys(%{$mapping})) {
                   13233:                         next if ($key =~ m{^https?://});
                   13234:                         my $ref = $mapping->{$key};
                   13235:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   13236:                         my $attrib;
                   13237:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   13238:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   13239:                         }
                   13240:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   13241:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   13242:                             $rewrites += $numchg;
                   13243:                         }
                   13244:                     }
                   13245:                     if ($rewrites) {
                   13246:                         my $saveresult; 
                   13247:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   13248:                         if ($url eq $container) {
                   13249:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   13250:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   13251:                                             $count,'<span class="LC_filename">'.
                   13252:                                             $fname.'</span>').'</p>';
                   13253:                         } else {
                   13254:                             $output .= '<p class="LC_error">'.
                   13255:                                        &mt('Error: could not update links in [_1].',
                   13256:                                        '<span class="LC_filename">'.
                   13257:                                        $container.'</span>').'</p>';
                   13258: 
                   13259:                         }
                   13260:                     }
                   13261:                 }
                   13262:             }
1.987     raeburn  13263:         } else {
                   13264:             &logthis('Failed to parse '.$container.
                   13265:                      ' to modify references: '.$parse_result);
1.661     raeburn  13266:         }
                   13267:     }
1.1071    raeburn  13268:     if (wantarray) {
                   13269:         return ($output,$count,$codebasecount);
                   13270:     } else {
                   13271:         return $output;
                   13272:     }
1.661     raeburn  13273: }
                   13274: 
                   13275: sub check_for_existing {
                   13276:     my ($path,$fname,$element) = @_;
                   13277:     my ($state,$msg);
                   13278:     if (-d $path.'/'.$fname) {
                   13279:         $state = 'exists';
                   13280:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   13281:     } elsif (-e $path.'/'.$fname) {
                   13282:         $state = 'exists';
                   13283:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   13284:     }
                   13285:     if ($state eq 'exists') {
                   13286:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   13287:     }
                   13288:     return ($state,$msg);
                   13289: }
                   13290: 
                   13291: sub check_for_upload {
                   13292:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   13293:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  13294:     my $filesize = length($env{'form.'.$element});
                   13295:     if (!$filesize) {
                   13296:         my $msg = '<span class="LC_error">'.
                   13297:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   13298:                       '<span class="LC_filename">'.$fname.'</span>',
                   13299:                       $filesize).'<br />'.
1.1007    raeburn  13300:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  13301:                   '</span>';
                   13302:         return ('zero_bytes',$msg);
                   13303:     }
                   13304:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  13305:     my $getpropath = 1;
1.1021    raeburn  13306:     my ($dirlistref,$listerror) =
                   13307:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  13308:     my $found_file = 0;
                   13309:     my $locked_file = 0;
1.991     raeburn  13310:     my @lockers;
                   13311:     my $navmap;
                   13312:     if ($env{'request.course.id'}) {
                   13313:         $navmap = Apache::lonnavmaps::navmap->new();
                   13314:     }
1.1021    raeburn  13315:     if (ref($dirlistref) eq 'ARRAY') {
                   13316:         foreach my $line (@{$dirlistref}) {
                   13317:             my ($file_name,$rest)=split(/\&/,$line,2);
                   13318:             if ($file_name eq $fname){
                   13319:                 $file_name = $path.$file_name;
                   13320:                 if ($group ne '') {
                   13321:                     $file_name = $group.$file_name;
                   13322:                 }
                   13323:                 $found_file = 1;
                   13324:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   13325:                     foreach my $lock (@lockers) {
                   13326:                         if (ref($lock) eq 'ARRAY') {
                   13327:                             my ($symb,$crsid) = @{$lock};
                   13328:                             if ($crsid eq $env{'request.course.id'}) {
                   13329:                                 if (ref($navmap)) {
                   13330:                                     my $res = $navmap->getBySymb($symb);
                   13331:                                     foreach my $part (@{$res->parts()}) { 
                   13332:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   13333:                                         unless (($slot_status == $res->RESERVED) ||
                   13334:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   13335:                                             $locked_file = 1;
                   13336:                                         }
1.991     raeburn  13337:                                     }
1.1021    raeburn  13338:                                 } else {
                   13339:                                     $locked_file = 1;
1.991     raeburn  13340:                                 }
                   13341:                             } else {
                   13342:                                 $locked_file = 1;
                   13343:                             }
                   13344:                         }
1.1021    raeburn  13345:                    }
                   13346:                 } else {
                   13347:                     my @info = split(/\&/,$rest);
                   13348:                     my $currsize = $info[6]/1000;
                   13349:                     if ($currsize < $filesize) {
                   13350:                         my $extra = $filesize - $currsize;
                   13351:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   13352:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  13353:                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
1.1179    bisitz   13354:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   13355:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   13356:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  13357:                             return ('will_exceed_quota',$msg);
                   13358:                         }
1.984     raeburn  13359:                     }
                   13360:                 }
1.661     raeburn  13361:             }
                   13362:         }
                   13363:     }
                   13364:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   13365:         my $msg = '<p class="LC_warning">'.
                   13366:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184    raeburn  13367:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  13368:         return ('will_exceed_quota',$msg);
                   13369:     } elsif ($found_file) {
                   13370:         if ($locked_file) {
1.1179    bisitz   13371:             my $msg = '<p class="LC_warning">';
1.661     raeburn  13372:             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
1.1179    bisitz   13373:             $msg .= '</p>';
1.661     raeburn  13374:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   13375:             return ('file_locked',$msg);
                   13376:         } else {
1.1179    bisitz   13377:             my $msg = '<p class="LC_error">';
1.984     raeburn  13378:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1179    bisitz   13379:             $msg .= '</p>';
1.984     raeburn  13380:             return ('existingfile',$msg);
1.661     raeburn  13381:         }
                   13382:     }
                   13383: }
                   13384: 
1.987     raeburn  13385: sub check_for_traversal {
                   13386:     my ($path,$url,$toplevel) = @_;
                   13387:     my @parts=split(/\//,$path);
                   13388:     my $cleanpath;
                   13389:     my $fullpath = $url;
                   13390:     for (my $i=0;$i<@parts;$i++) {
                   13391:         next if ($parts[$i] eq '.');
                   13392:         if ($parts[$i] eq '..') {
                   13393:             $fullpath =~ s{([^/]+/)$}{};
                   13394:         } else {
                   13395:             $fullpath .= $parts[$i].'/';
                   13396:         }
                   13397:     }
                   13398:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   13399:         $cleanpath = $1;
                   13400:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   13401:         my $curr_toprel = $1;
                   13402:         my @parts = split(/\//,$curr_toprel);
                   13403:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   13404:         my @urlparts = split(/\//,$url_toprel);
                   13405:         my $doubledots;
                   13406:         my $startdiff = -1;
                   13407:         for (my $i=0; $i<@urlparts; $i++) {
                   13408:             if ($startdiff == -1) {
                   13409:                 unless ($urlparts[$i] eq $parts[$i]) {
                   13410:                     $startdiff = $i;
                   13411:                     $doubledots .= '../';
                   13412:                 }
                   13413:             } else {
                   13414:                 $doubledots .= '../';
                   13415:             }
                   13416:         }
                   13417:         if ($startdiff > -1) {
                   13418:             $cleanpath = $doubledots;
                   13419:             for (my $i=$startdiff; $i<@parts; $i++) {
                   13420:                 $cleanpath .= $parts[$i].'/';
                   13421:             }
                   13422:         }
                   13423:     }
                   13424:     $cleanpath =~ s{(/)$}{};
                   13425:     return $cleanpath;
                   13426: }
1.31      albertel 13427: 
1.1053    raeburn  13428: sub is_archive_file {
                   13429:     my ($mimetype) = @_;
                   13430:     if (($mimetype eq 'application/octet-stream') ||
                   13431:         ($mimetype eq 'application/x-stuffit') ||
                   13432:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   13433:         return 1;
                   13434:     }
                   13435:     return;
                   13436: }
                   13437: 
                   13438: sub decompress_form {
1.1065    raeburn  13439:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  13440:     my %lt = &Apache::lonlocal::texthash (
                   13441:         this => 'This file is an archive file.',
1.1067    raeburn  13442:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  13443:         itsc => 'Its contents are as follows:',
1.1053    raeburn  13444:         youm => 'You may wish to extract its contents.',
                   13445:         extr => 'Extract contents',
1.1067    raeburn  13446:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   13447:         proa => 'Process automatically?',
1.1053    raeburn  13448:         yes  => 'Yes',
                   13449:         no   => 'No',
1.1067    raeburn  13450:         fold => 'Title for folder containing movie',
                   13451:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  13452:     );
1.1065    raeburn  13453:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  13454:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  13455:     my $info = &list_archive_contents($fileloc,\@paths);
                   13456:     if (@paths) {
                   13457:         foreach my $path (@paths) {
                   13458:             $path =~ s{^/}{};
1.1067    raeburn  13459:             if ($path =~ m{^([^/]+)/$}) {
                   13460:                 $topdir = $1;
                   13461:             }
1.1065    raeburn  13462:             if ($path =~ m{^([^/]+)/}) {
                   13463:                 $toplevel{$1} = $path;
                   13464:             } else {
                   13465:                 $toplevel{$path} = $path;
                   13466:             }
                   13467:         }
                   13468:     }
1.1067    raeburn  13469:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  13470:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  13471:                         "$topdir/media/",
                   13472:                         "$topdir/media/$topdir.mp4",
                   13473:                         "$topdir/media/FirstFrame.png",
                   13474:                         "$topdir/media/player.swf",
                   13475:                         "$topdir/media/swfobject.js",
                   13476:                         "$topdir/media/expressInstall.swf");
1.1197    raeburn  13477:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164    raeburn  13478:                          "$topdir/$topdir.mp4",
                   13479:                          "$topdir/$topdir\_config.xml",
                   13480:                          "$topdir/$topdir\_controller.swf",
                   13481:                          "$topdir/$topdir\_embed.css",
                   13482:                          "$topdir/$topdir\_First_Frame.png",
                   13483:                          "$topdir/$topdir\_player.html",
                   13484:                          "$topdir/$topdir\_Thumbnails.png",
                   13485:                          "$topdir/playerProductInstall.swf",
                   13486:                          "$topdir/scripts/",
                   13487:                          "$topdir/scripts/config_xml.js",
                   13488:                          "$topdir/scripts/handlebars.js",
                   13489:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   13490:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   13491:                          "$topdir/scripts/modernizr.js",
                   13492:                          "$topdir/scripts/player-min.js",
                   13493:                          "$topdir/scripts/swfobject.js",
                   13494:                          "$topdir/skins/",
                   13495:                          "$topdir/skins/configuration_express.xml",
                   13496:                          "$topdir/skins/express_show/",
                   13497:                          "$topdir/skins/express_show/player-min.css",
                   13498:                          "$topdir/skins/express_show/spritesheet.png");
1.1197    raeburn  13499:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   13500:                          "$topdir/$topdir.mp4",
                   13501:                          "$topdir/$topdir\_config.xml",
                   13502:                          "$topdir/$topdir\_controller.swf",
                   13503:                          "$topdir/$topdir\_embed.css",
                   13504:                          "$topdir/$topdir\_First_Frame.png",
                   13505:                          "$topdir/$topdir\_player.html",
                   13506:                          "$topdir/$topdir\_Thumbnails.png",
                   13507:                          "$topdir/playerProductInstall.swf",
                   13508:                          "$topdir/scripts/",
                   13509:                          "$topdir/scripts/config_xml.js",
                   13510:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   13511:                          "$topdir/skins/",
                   13512:                          "$topdir/skins/configuration_express.xml",
                   13513:                          "$topdir/skins/express_show/",
                   13514:                          "$topdir/skins/express_show/spritesheet.min.css",
                   13515:                          "$topdir/skins/express_show/spritesheet.png",
                   13516:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164    raeburn  13517:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  13518:         if (@diffs == 0) {
1.1164    raeburn  13519:             $is_camtasia = 6;
                   13520:         } else {
1.1197    raeburn  13521:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164    raeburn  13522:             if (@diffs == 0) {
                   13523:                 $is_camtasia = 8;
1.1197    raeburn  13524:             } else {
                   13525:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   13526:                 if (@diffs == 0) {
                   13527:                     $is_camtasia = 8;
                   13528:                 }
1.1164    raeburn  13529:             }
1.1067    raeburn  13530:         }
                   13531:     }
                   13532:     my $output;
                   13533:     if ($is_camtasia) {
                   13534:         $output = <<"ENDCAM";
                   13535: <script type="text/javascript" language="Javascript">
                   13536: // <![CDATA[
                   13537: 
                   13538: function camtasiaToggle() {
                   13539:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   13540:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  13541:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  13542:                 document.getElementById('camtasia_titles').style.display='block';
                   13543:             } else {
                   13544:                 document.getElementById('camtasia_titles').style.display='none';
                   13545:             }
                   13546:         }
                   13547:     }
                   13548:     return;
                   13549: }
                   13550: 
                   13551: // ]]>
                   13552: </script>
                   13553: <p>$lt{'camt'}</p>
                   13554: ENDCAM
1.1065    raeburn  13555:     } else {
1.1067    raeburn  13556:         $output = '<p>'.$lt{'this'};
                   13557:         if ($info eq '') {
                   13558:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   13559:         } else {
                   13560:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   13561:                        '<div><pre>'.$info.'</pre></div>';
                   13562:         }
1.1065    raeburn  13563:     }
1.1067    raeburn  13564:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  13565:     my $duplicates;
                   13566:     my $num = 0;
                   13567:     if (ref($dirlist) eq 'ARRAY') {
                   13568:         foreach my $item (@{$dirlist}) {
                   13569:             if (ref($item) eq 'ARRAY') {
                   13570:                 if (exists($toplevel{$item->[0]})) {
                   13571:                     $duplicates .= 
                   13572:                         &start_data_table_row().
                   13573:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   13574:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   13575:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   13576:                         'value="1" />'.&mt('Yes').'</label>'.
                   13577:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   13578:                         '<td>'.$item->[0].'</td>';
                   13579:                     if ($item->[2]) {
                   13580:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   13581:                     } else {
                   13582:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   13583:                     }
                   13584:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   13585:                                    '<td>'.
                   13586:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   13587:                                    '</td>'.
                   13588:                                    &end_data_table_row();
                   13589:                     $num ++;
                   13590:                 }
                   13591:             }
                   13592:         }
                   13593:     }
                   13594:     my $itemcount;
                   13595:     if (@paths > 0) {
                   13596:         $itemcount = scalar(@paths);
                   13597:     } else {
                   13598:         $itemcount = 1;
                   13599:     }
1.1067    raeburn  13600:     if ($is_camtasia) {
                   13601:         $output .= $lt{'auto'}.'<br />'.
                   13602:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  13603:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  13604:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   13605:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   13606:                    $lt{'no'}.'</label></span><br />'.
                   13607:                    '<div id="camtasia_titles" style="display:block">'.
                   13608:                    &Apache::lonhtmlcommon::start_pick_box().
                   13609:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   13610:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   13611:                    &Apache::lonhtmlcommon::row_closure().
                   13612:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   13613:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   13614:                    &Apache::lonhtmlcommon::row_closure(1).
                   13615:                    &Apache::lonhtmlcommon::end_pick_box().
                   13616:                    '</div>';
                   13617:     }
1.1065    raeburn  13618:     $output .= 
                   13619:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  13620:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   13621:         "\n";
1.1065    raeburn  13622:     if ($duplicates ne '') {
                   13623:         $output .= '<p><span class="LC_warning">'.
                   13624:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   13625:                    &start_data_table().
                   13626:                    &start_data_table_header_row().
                   13627:                    '<th>'.&mt('Overwrite?').'</th>'.
                   13628:                    '<th>'.&mt('Name').'</th>'.
                   13629:                    '<th>'.&mt('Type').'</th>'.
                   13630:                    '<th>'.&mt('Size').'</th>'.
                   13631:                    '<th>'.&mt('Last modified').'</th>'.
                   13632:                    &end_data_table_header_row().
                   13633:                    $duplicates.
                   13634:                    &end_data_table().
                   13635:                    '</p>';
                   13636:     }
1.1067    raeburn  13637:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  13638:     if (ref($hiddenelements) eq 'HASH') {
                   13639:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   13640:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   13641:         }
                   13642:     }
                   13643:     $output .= <<"END";
1.1067    raeburn  13644: <br />
1.1053    raeburn  13645: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   13646: </form>
                   13647: $noextract
                   13648: END
                   13649:     return $output;
                   13650: }
                   13651: 
1.1065    raeburn  13652: sub decompression_utility {
                   13653:     my ($program) = @_;
                   13654:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   13655:     my $location;
                   13656:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   13657:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   13658:                          '/usr/sbin/') {
                   13659:             if (-x $dir.$program) {
                   13660:                 $location = $dir.$program;
                   13661:                 last;
                   13662:             }
                   13663:         }
                   13664:     }
                   13665:     return $location;
                   13666: }
                   13667: 
                   13668: sub list_archive_contents {
                   13669:     my ($file,$pathsref) = @_;
                   13670:     my (@cmd,$output);
                   13671:     my $needsregexp;
                   13672:     if ($file =~ /\.zip$/) {
                   13673:         @cmd = (&decompression_utility('unzip'),"-l");
                   13674:         $needsregexp = 1;
                   13675:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   13676:              ($file =~ /\.tgz$/)) {
                   13677:         @cmd = (&decompression_utility('tar'),"-ztf");
                   13678:     } elsif ($file =~ /\.tar\.bz2$/) {
                   13679:         @cmd = (&decompression_utility('tar'),"-jtf");
                   13680:     } elsif ($file =~ m|\.tar$|) {
                   13681:         @cmd = (&decompression_utility('tar'),"-tf");
                   13682:     }
                   13683:     if (@cmd) {
                   13684:         undef($!);
                   13685:         undef($@);
                   13686:         if (open(my $fh,"-|", @cmd, $file)) {
                   13687:             while (my $line = <$fh>) {
                   13688:                 $output .= $line;
                   13689:                 chomp($line);
                   13690:                 my $item;
                   13691:                 if ($needsregexp) {
                   13692:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   13693:                 } else {
                   13694:                     $item = $line;
                   13695:                 }
                   13696:                 if ($item ne '') {
                   13697:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   13698:                         push(@{$pathsref},$item);
                   13699:                     } 
                   13700:                 }
                   13701:             }
                   13702:             close($fh);
                   13703:         }
                   13704:     }
                   13705:     return $output;
                   13706: }
                   13707: 
1.1053    raeburn  13708: sub decompress_uploaded_file {
                   13709:     my ($file,$dir) = @_;
                   13710:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   13711:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   13712:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   13713:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   13714:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   13715:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   13716:     my $decompressed = $env{'cgi.decompressed'};
                   13717:     &Apache::lonnet::delenv('cgi.file');
                   13718:     &Apache::lonnet::delenv('cgi.dir');
                   13719:     &Apache::lonnet::delenv('cgi.decompressed');
                   13720:     return ($decompressed,$result);
                   13721: }
                   13722: 
1.1055    raeburn  13723: sub process_decompression {
                   13724:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292    raeburn  13725:     unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
                   13726:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13727:                &mt('Unexpected file path.').'</p>'."\n";
                   13728:     }
                   13729:     unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
                   13730:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13731:                &mt('Unexpected course context.').'</p>'."\n";
                   13732:     }
1.1293    raeburn  13733:     unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292    raeburn  13734:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13735:                &mt('Filename contained unexpected characters.').'</p>'."\n";
                   13736:     }
1.1055    raeburn  13737:     my ($dir,$error,$warning,$output);
1.1180    raeburn  13738:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   13739:         $error = &mt('Filename not a supported archive file type.').
                   13740:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  13741:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   13742:     } else {
                   13743:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   13744:         if ($docuhome eq 'no_host') {
                   13745:             $error = &mt('Could not determine home server for course.');
                   13746:         } else {
                   13747:             my @ids=&Apache::lonnet::current_machine_ids();
                   13748:             my $currdir = "$dir_root/$destination";
                   13749:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   13750:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   13751:                        "$dir_root/$destination";
                   13752:             } else {
                   13753:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   13754:                        "$dir_root/$docudom/$docuname/$destination";
                   13755:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   13756:                     $error = &mt('Archive file not found.');
                   13757:                 }
                   13758:             }
1.1065    raeburn  13759:             my (@to_overwrite,@to_skip);
                   13760:             if ($env{'form.archive_overwrite_total'} > 0) {
                   13761:                 my $total = $env{'form.archive_overwrite_total'};
                   13762:                 for (my $i=0; $i<$total; $i++) {
                   13763:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   13764:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   13765:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   13766:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   13767:                     }
                   13768:                 }
                   13769:             }
                   13770:             my $numskip = scalar(@to_skip);
1.1292    raeburn  13771:             my $numoverwrite = scalar(@to_overwrite);
                   13772:             if (($numskip) && (!$numoverwrite)) { 
1.1065    raeburn  13773:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   13774:             } elsif ($dir eq '') {
1.1055    raeburn  13775:                 $error = &mt('Directory containing archive file unavailable.');
                   13776:             } elsif (!$error) {
1.1065    raeburn  13777:                 my ($decompressed,$display);
1.1292    raeburn  13778:                 if (($numskip) || ($numoverwrite)) {
1.1065    raeburn  13779:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   13780:                     mkdir("$dir/$tempdir",0755);
1.1292    raeburn  13781:                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                   13782:                         ($decompressed,$display) = 
                   13783:                             &decompress_uploaded_file($file,"$dir/$tempdir");
                   13784:                         foreach my $item (@to_skip) {
                   13785:                             if (($item ne '') && ($item !~ /\.\./)) {
                   13786:                                 if (-f "$dir/$tempdir/$item") { 
                   13787:                                     unlink("$dir/$tempdir/$item");
                   13788:                                 } elsif (-d "$dir/$tempdir/$item") {
1.1300    raeburn  13789:                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292    raeburn  13790:                                 }
                   13791:                             }
                   13792:                         }
                   13793:                         foreach my $item (@to_overwrite) {
                   13794:                             if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
                   13795:                                 if (($item ne '') && ($item !~ /\.\./)) {
                   13796:                                     if (-f "$dir/$item") {
                   13797:                                         unlink("$dir/$item");
                   13798:                                     } elsif (-d "$dir/$item") {
1.1300    raeburn  13799:                                         &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292    raeburn  13800:                                     }
                   13801:                                     &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
                   13802:                                 }
1.1065    raeburn  13803:                             }
                   13804:                         }
1.1292    raeburn  13805:                         if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300    raeburn  13806:                             &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292    raeburn  13807:                         }
1.1065    raeburn  13808:                     }
                   13809:                 } else {
                   13810:                     ($decompressed,$display) = 
                   13811:                         &decompress_uploaded_file($file,$dir);
                   13812:                 }
1.1055    raeburn  13813:                 if ($decompressed eq 'ok') {
1.1065    raeburn  13814:                     $output = '<p class="LC_info">'.
                   13815:                               &mt('Files extracted successfully from archive.').
                   13816:                               '</p>'."\n";
1.1055    raeburn  13817:                     my ($warning,$result,@contents);
                   13818:                     my ($newdirlistref,$newlisterror) =
                   13819:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   13820:                                                  $docuname,1);
                   13821:                     my (%is_dir,%changes,@newitems);
                   13822:                     my $dirptr = 16384;
1.1065    raeburn  13823:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  13824:                         foreach my $dir_line (@{$newdirlistref}) {
                   13825:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292    raeburn  13826:                             unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055    raeburn  13827:                                 push(@newitems,$item);
                   13828:                                 if ($dirptr&$testdir) {
                   13829:                                     $is_dir{$item} = 1;
                   13830:                                 }
                   13831:                                 $changes{$item} = 1;
                   13832:                             }
                   13833:                         }
                   13834:                     }
                   13835:                     if (keys(%changes) > 0) {
                   13836:                         foreach my $item (sort(@newitems)) {
                   13837:                             if ($changes{$item}) {
                   13838:                                 push(@contents,$item);
                   13839:                             }
                   13840:                         }
                   13841:                     }
                   13842:                     if (@contents > 0) {
1.1067    raeburn  13843:                         my $wantform;
                   13844:                         unless ($env{'form.autoextract_camtasia'}) {
                   13845:                             $wantform = 1;
                   13846:                         }
1.1056    raeburn  13847:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  13848:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   13849:                                                                 $currdir,\%is_dir,
                   13850:                                                                 \%children,\%parent,
1.1056    raeburn  13851:                                                                 \@contents,\%dirorder,
                   13852:                                                                 \%titles,$wantform);
1.1055    raeburn  13853:                         if ($datatable ne '') {
                   13854:                             $output .= &archive_options_form('decompressed',$datatable,
                   13855:                                                              $count,$hiddenelem);
1.1065    raeburn  13856:                             my $startcount = 6;
1.1055    raeburn  13857:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  13858:                                                            \%titles,\%children);
1.1055    raeburn  13859:                         }
1.1067    raeburn  13860:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  13861:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  13862:                             my %displayed;
                   13863:                             my $total = 1;
                   13864:                             $env{'form.archive_directory'} = [];
                   13865:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   13866:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   13867:                                 $path =~ s{/$}{};
                   13868:                                 my $item;
                   13869:                                 if ($path ne '') {
                   13870:                                     $item = "$path/$titles{$i}";
                   13871:                                 } else {
                   13872:                                     $item = $titles{$i};
                   13873:                                 }
                   13874:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   13875:                                 if ($item eq $contents[0]) {
                   13876:                                     push(@{$env{'form.archive_directory'}},$i);
                   13877:                                     $env{'form.archive_'.$i} = 'display';
                   13878:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   13879:                                     $displayed{'folder'} = $i;
1.1164    raeburn  13880:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   13881:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  13882:                                     $env{'form.archive_'.$i} = 'display';
                   13883:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   13884:                                     $displayed{'web'} = $i;
                   13885:                                 } else {
1.1164    raeburn  13886:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   13887:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   13888:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  13889:                                         push(@{$env{'form.archive_directory'}},$i);
                   13890:                                     }
                   13891:                                     $env{'form.archive_'.$i} = 'dependency';
                   13892:                                 }
                   13893:                                 $total ++;
                   13894:                             }
                   13895:                             for (my $i=1; $i<$total; $i++) {
                   13896:                                 next if ($i == $displayed{'web'});
                   13897:                                 next if ($i == $displayed{'folder'});
                   13898:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   13899:                             }
                   13900:                             $env{'form.phase'} = 'decompress_cleanup';
                   13901:                             $env{'form.archivedelete'} = 1;
                   13902:                             $env{'form.archive_count'} = $total-1;
                   13903:                             $output .=
                   13904:                                 &process_extracted_files('coursedocs',$docudom,
                   13905:                                                          $docuname,$destination,
                   13906:                                                          $dir_root,$hiddenelem);
                   13907:                         }
1.1055    raeburn  13908:                     } else {
                   13909:                         $warning = &mt('No new items extracted from archive file.');
                   13910:                     }
                   13911:                 } else {
                   13912:                     $output = $display;
                   13913:                     $error = &mt('An error occurred during extraction from the archive file.');
                   13914:                 }
                   13915:             }
                   13916:         }
                   13917:     }
                   13918:     if ($error) {
                   13919:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13920:                    $error.'</p>'."\n";
                   13921:     }
                   13922:     if ($warning) {
                   13923:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   13924:     }
                   13925:     return $output;
                   13926: }
                   13927: 
                   13928: sub get_extracted {
1.1056    raeburn  13929:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   13930:         $titles,$wantform) = @_;
1.1055    raeburn  13931:     my $count = 0;
                   13932:     my $depth = 0;
                   13933:     my $datatable;
1.1056    raeburn  13934:     my @hierarchy;
1.1055    raeburn  13935:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  13936:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   13937:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  13938:     foreach my $item (@{$contents}) {
                   13939:         $count ++;
1.1056    raeburn  13940:         @{$dirorder->{$count}} = @hierarchy;
                   13941:         $titles->{$count} = $item;
1.1055    raeburn  13942:         &archive_hierarchy($depth,$count,$parent,$children);
                   13943:         if ($wantform) {
                   13944:             $datatable .= &archive_row($is_dir->{$item},$item,
                   13945:                                        $currdir,$depth,$count);
                   13946:         }
                   13947:         if ($is_dir->{$item}) {
                   13948:             $depth ++;
1.1056    raeburn  13949:             push(@hierarchy,$count);
                   13950:             $parent->{$depth} = $count;
1.1055    raeburn  13951:             $datatable .=
                   13952:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  13953:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   13954:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  13955:             $depth --;
1.1056    raeburn  13956:             pop(@hierarchy);
1.1055    raeburn  13957:         }
                   13958:     }
                   13959:     return ($count,$datatable);
                   13960: }
                   13961: 
                   13962: sub recurse_extracted_archive {
1.1056    raeburn  13963:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   13964:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  13965:     my $result='';
1.1056    raeburn  13966:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   13967:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   13968:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  13969:         return $result;
                   13970:     }
                   13971:     my $dirptr = 16384;
                   13972:     my ($newdirlistref,$newlisterror) =
                   13973:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   13974:     if (ref($newdirlistref) eq 'ARRAY') {
                   13975:         foreach my $dir_line (@{$newdirlistref}) {
                   13976:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   13977:             unless ($item =~ /^\.+$/) {
                   13978:                 $$count ++;
1.1056    raeburn  13979:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   13980:                 $titles->{$$count} = $item;
1.1055    raeburn  13981:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  13982: 
1.1055    raeburn  13983:                 my $is_dir;
                   13984:                 if ($dirptr&$testdir) {
                   13985:                     $is_dir = 1;
                   13986:                 }
                   13987:                 if ($wantform) {
                   13988:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   13989:                 }
                   13990:                 if ($is_dir) {
                   13991:                     $$depth ++;
1.1056    raeburn  13992:                     push(@{$hierarchy},$$count);
                   13993:                     $parent->{$$depth} = $$count;
1.1055    raeburn  13994:                     $result .=
                   13995:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   13996:                                                    $docuname,$depth,$count,
1.1056    raeburn  13997:                                                    $hierarchy,$dirorder,$children,
                   13998:                                                    $parent,$titles,$wantform);
1.1055    raeburn  13999:                     $$depth --;
1.1056    raeburn  14000:                     pop(@{$hierarchy});
1.1055    raeburn  14001:                 }
                   14002:             }
                   14003:         }
                   14004:     }
                   14005:     return $result;
                   14006: }
                   14007: 
                   14008: sub archive_hierarchy {
                   14009:     my ($depth,$count,$parent,$children) =@_;
                   14010:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   14011:         if (exists($parent->{$depth})) {
                   14012:              $children->{$parent->{$depth}} .= $count.':';
                   14013:         }
                   14014:     }
                   14015:     return;
                   14016: }
                   14017: 
                   14018: sub archive_row {
                   14019:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   14020:     my ($name) = ($item =~ m{([^/]+)$});
                   14021:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  14022:                                        'display'    => 'Add as file',
1.1055    raeburn  14023:                                        'dependency' => 'Include as dependency',
                   14024:                                        'discard'    => 'Discard',
                   14025:                                       );
                   14026:     if ($is_dir) {
1.1059    raeburn  14027:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  14028:     }
1.1056    raeburn  14029:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   14030:     my $offset = 0;
1.1055    raeburn  14031:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  14032:         $offset ++;
1.1065    raeburn  14033:         if ($action ne 'display') {
                   14034:             $offset ++;
                   14035:         }  
1.1055    raeburn  14036:         $output .= '<td><span class="LC_nobreak">'.
                   14037:                    '<label><input type="radio" name="archive_'.$count.
                   14038:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   14039:         my $text = $choices{$action};
                   14040:         if ($is_dir) {
                   14041:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   14042:             if ($action eq 'display') {
1.1059    raeburn  14043:                 $text = &mt('Add as folder');
1.1055    raeburn  14044:             }
1.1056    raeburn  14045:         } else {
                   14046:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   14047: 
                   14048:         }
                   14049:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   14050:         if ($action eq 'dependency') {
                   14051:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   14052:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   14053:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   14054:                        '<option value=""></option>'."\n".
                   14055:                        '</select>'."\n".
                   14056:                        '</div>';
1.1059    raeburn  14057:         } elsif ($action eq 'display') {
                   14058:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   14059:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   14060:                        '</div>';
1.1055    raeburn  14061:         }
1.1056    raeburn  14062:         $output .= '</td>';
1.1055    raeburn  14063:     }
                   14064:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   14065:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   14066:     for (my $i=0; $i<$depth; $i++) {
                   14067:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   14068:     }
                   14069:     if ($is_dir) {
                   14070:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   14071:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   14072:     } else {
                   14073:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   14074:     }
                   14075:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   14076:                &end_data_table_row();
                   14077:     return $output;
                   14078: }
                   14079: 
                   14080: sub archive_options_form {
1.1065    raeburn  14081:     my ($form,$display,$count,$hiddenelem) = @_;
                   14082:     my %lt = &Apache::lonlocal::texthash(
                   14083:                perm => 'Permanently remove archive file?',
                   14084:                hows => 'How should each extracted item be incorporated in the course?',
                   14085:                cont => 'Content actions for all',
                   14086:                addf => 'Add as folder/file',
                   14087:                incd => 'Include as dependency for a displayed file',
                   14088:                disc => 'Discard',
                   14089:                no   => 'No',
                   14090:                yes  => 'Yes',
                   14091:                save => 'Save',
                   14092:     );
                   14093:     my $output = <<"END";
                   14094: <form name="$form" method="post" action="">
                   14095: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   14096: <label>
                   14097:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   14098: </label>
                   14099: &nbsp;
                   14100: <label>
                   14101:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   14102: </span>
                   14103: </p>
                   14104: <input type="hidden" name="phase" value="decompress_cleanup" />
                   14105: <br />$lt{'hows'}
                   14106: <div class="LC_columnSection">
                   14107:   <fieldset>
                   14108:     <legend>$lt{'cont'}</legend>
                   14109:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   14110:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   14111:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   14112:   </fieldset>
                   14113: </div>
                   14114: END
                   14115:     return $output.
1.1055    raeburn  14116:            &start_data_table()."\n".
1.1065    raeburn  14117:            $display."\n".
1.1055    raeburn  14118:            &end_data_table()."\n".
                   14119:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   14120:            $hiddenelem.
1.1065    raeburn  14121:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  14122:            '</form>';
                   14123: }
                   14124: 
                   14125: sub archive_javascript {
1.1056    raeburn  14126:     my ($startcount,$numitems,$titles,$children) = @_;
                   14127:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  14128:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  14129:     my $scripttag = <<START;
                   14130: <script type="text/javascript">
                   14131: // <![CDATA[
                   14132: 
                   14133: function checkAll(form,prefix) {
                   14134:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   14135:     for (var i=0; i < form.elements.length; i++) {
                   14136:         var id = form.elements[i].id;
                   14137:         if ((id != '') && (id != undefined)) {
                   14138:             if (idstr.test(id)) {
                   14139:                 if (form.elements[i].type == 'radio') {
                   14140:                     form.elements[i].checked = true;
1.1056    raeburn  14141:                     var nostart = i-$startcount;
1.1059    raeburn  14142:                     var offset = nostart%7;
                   14143:                     var count = (nostart-offset)/7;    
1.1056    raeburn  14144:                     dependencyCheck(form,count,offset);
1.1055    raeburn  14145:                 }
                   14146:             }
                   14147:         }
                   14148:     }
                   14149: }
                   14150: 
                   14151: function propagateCheck(form,count) {
                   14152:     if (count > 0) {
1.1059    raeburn  14153:         var startelement = $startcount + ((count-1) * 7);
                   14154:         for (var j=1; j<6; j++) {
                   14155:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  14156:                 var item = startelement + j; 
                   14157:                 if (form.elements[item].type == 'radio') {
                   14158:                     if (form.elements[item].checked) {
                   14159:                         containerCheck(form,count,j);
                   14160:                         break;
                   14161:                     }
1.1055    raeburn  14162:                 }
                   14163:             }
                   14164:         }
                   14165:     }
                   14166: }
                   14167: 
                   14168: numitems = $numitems
1.1056    raeburn  14169: var titles = new Array(numitems);
                   14170: var parents = new Array(numitems);
1.1055    raeburn  14171: for (var i=0; i<numitems; i++) {
1.1056    raeburn  14172:     parents[i] = new Array;
1.1055    raeburn  14173: }
1.1059    raeburn  14174: var maintitle = '$maintitle';
1.1055    raeburn  14175: 
                   14176: START
                   14177: 
1.1056    raeburn  14178:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   14179:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  14180:         for (my $i=0; $i<@contents; $i ++) {
                   14181:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   14182:         }
                   14183:     }
                   14184: 
1.1056    raeburn  14185:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   14186:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   14187:     }
                   14188: 
1.1055    raeburn  14189:     $scripttag .= <<END;
                   14190: 
                   14191: function containerCheck(form,count,offset) {
                   14192:     if (count > 0) {
1.1056    raeburn  14193:         dependencyCheck(form,count,offset);
1.1059    raeburn  14194:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  14195:         form.elements[item].checked = true;
                   14196:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   14197:             if (parents[count].length > 0) {
                   14198:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  14199:                     containerCheck(form,parents[count][j],offset);
                   14200:                 }
                   14201:             }
                   14202:         }
                   14203:     }
                   14204: }
                   14205: 
                   14206: function dependencyCheck(form,count,offset) {
                   14207:     if (count > 0) {
1.1059    raeburn  14208:         var chosen = (offset+$startcount)+7*(count-1);
                   14209:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  14210:         var currtype = form.elements[depitem].type;
                   14211:         if (form.elements[chosen].value == 'dependency') {
                   14212:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   14213:             form.elements[depitem].options.length = 0;
                   14214:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  14215:             for (var i=1; i<=numitems; i++) {
                   14216:                 if (i == count) {
                   14217:                     continue;
                   14218:                 }
1.1059    raeburn  14219:                 var startelement = $startcount + (i-1) * 7;
                   14220:                 for (var j=1; j<6; j++) {
                   14221:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  14222:                         var item = startelement + j;
                   14223:                         if (form.elements[item].type == 'radio') {
                   14224:                             if (form.elements[item].checked) {
                   14225:                                 if (form.elements[item].value == 'display') {
                   14226:                                     var n = form.elements[depitem].options.length;
                   14227:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   14228:                                 }
                   14229:                             }
                   14230:                         }
                   14231:                     }
                   14232:                 }
                   14233:             }
                   14234:         } else {
                   14235:             document.getElementById('arc_depon_'+count).style.display='none';
                   14236:             form.elements[depitem].options.length = 0;
                   14237:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   14238:         }
1.1059    raeburn  14239:         titleCheck(form,count,offset);
1.1056    raeburn  14240:     }
                   14241: }
                   14242: 
                   14243: function propagateSelect(form,count,offset) {
                   14244:     if (count > 0) {
1.1065    raeburn  14245:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  14246:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   14247:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   14248:             if (parents[count].length > 0) {
                   14249:                 for (var j=0; j<parents[count].length; j++) {
                   14250:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  14251:                 }
                   14252:             }
                   14253:         }
                   14254:     }
                   14255: }
1.1056    raeburn  14256: 
                   14257: function containerSelect(form,count,offset,picked) {
                   14258:     if (count > 0) {
1.1065    raeburn  14259:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  14260:         if (form.elements[item].type == 'radio') {
                   14261:             if (form.elements[item].value == 'dependency') {
                   14262:                 if (form.elements[item+1].type == 'select-one') {
                   14263:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   14264:                         if (form.elements[item+1].options[i].value == picked) {
                   14265:                             form.elements[item+1].selectedIndex = i;
                   14266:                             break;
                   14267:                         }
                   14268:                     }
                   14269:                 }
                   14270:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   14271:                     if (parents[count].length > 0) {
                   14272:                         for (var j=0; j<parents[count].length; j++) {
                   14273:                             containerSelect(form,parents[count][j],offset,picked);
                   14274:                         }
                   14275:                     }
                   14276:                 }
                   14277:             }
                   14278:         }
                   14279:     }
                   14280: }
                   14281: 
1.1059    raeburn  14282: function titleCheck(form,count,offset) {
                   14283:     if (count > 0) {
                   14284:         var chosen = (offset+$startcount)+7*(count-1);
                   14285:         var depitem = $startcount + ((count-1) * 7) + 2;
                   14286:         var currtype = form.elements[depitem].type;
                   14287:         if (form.elements[chosen].value == 'display') {
                   14288:             document.getElementById('arc_title_'+count).style.display='block';
                   14289:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   14290:                 document.getElementById('archive_title_'+count).value=maintitle;
                   14291:             }
                   14292:         } else {
                   14293:             document.getElementById('arc_title_'+count).style.display='none';
                   14294:             if (currtype == 'text') { 
                   14295:                 document.getElementById('archive_title_'+count).value='';
                   14296:             }
                   14297:         }
                   14298:     }
                   14299:     return;
                   14300: }
                   14301: 
1.1055    raeburn  14302: // ]]>
                   14303: </script>
                   14304: END
                   14305:     return $scripttag;
                   14306: }
                   14307: 
                   14308: sub process_extracted_files {
1.1067    raeburn  14309:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  14310:     my $numitems = $env{'form.archive_count'};
1.1294    raeburn  14311:     return if ((!$numitems) || ($numitems =~ /\D/));
1.1055    raeburn  14312:     my @ids=&Apache::lonnet::current_machine_ids();
                   14313:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  14314:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  14315:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   14316:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   14317:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   14318:         $pathtocheck = "$dir_root/$destination";
                   14319:         $dir = $dir_root;
                   14320:         $ishome = 1;
                   14321:     } else {
                   14322:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   14323:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294    raeburn  14324:         $dir = "$dir_root/$docudom/$docuname";
1.1055    raeburn  14325:     }
                   14326:     my $currdir = "$dir_root/$destination";
                   14327:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   14328:     if ($env{'form.folderpath'}) {
                   14329:         my @items = split('&',$env{'form.folderpath'});
                   14330:         $folders{'0'} = $items[-2];
1.1099    raeburn  14331:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   14332:             $containers{'0'}='page';
                   14333:         } else {  
                   14334:             $containers{'0'}='sequence';
                   14335:         }
1.1055    raeburn  14336:     }
                   14337:     my @archdirs = &get_env_multiple('form.archive_directory');
                   14338:     if ($numitems) {
                   14339:         for (my $i=1; $i<=$numitems; $i++) {
                   14340:             my $path = $env{'form.archive_content_'.$i};
                   14341:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   14342:                 my $item = $1;
                   14343:                 $toplevelitems{$item} = $i;
                   14344:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   14345:                     $is_dir{$item} = 1;
                   14346:                 }
                   14347:             }
                   14348:         }
                   14349:     }
1.1067    raeburn  14350:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  14351:     if (keys(%toplevelitems) > 0) {
                   14352:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  14353:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   14354:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  14355:     }
1.1066    raeburn  14356:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  14357:     if ($numitems) {
                   14358:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  14359:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  14360:             my $path = $env{'form.archive_content_'.$i};
                   14361:             if ($path =~ /^\Q$pathtocheck\E/) {
                   14362:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   14363:                     if ($prefix ne '' && $path ne '') {
                   14364:                         if (-e $prefix.$path) {
1.1066    raeburn  14365:                             if ((@archdirs > 0) && 
                   14366:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   14367:                                 $todeletedir{$prefix.$path} = 1;
                   14368:                             } else {
                   14369:                                 $todelete{$prefix.$path} = 1;
                   14370:                             }
1.1055    raeburn  14371:                         }
                   14372:                     }
                   14373:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  14374:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  14375:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  14376:                     $docstitle = $env{'form.archive_title_'.$i};
                   14377:                     if ($docstitle eq '') {
                   14378:                         $docstitle = $title;
                   14379:                     }
1.1055    raeburn  14380:                     $outer = 0;
1.1056    raeburn  14381:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   14382:                         if (@{$dirorder{$i}} > 0) {
                   14383:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  14384:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   14385:                                     $outer = $item;
                   14386:                                     last;
                   14387:                                 }
                   14388:                             }
                   14389:                         }
                   14390:                     }
                   14391:                     my ($errtext,$fatal) = 
                   14392:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   14393:                                                '/'.$folders{$outer}.'.'.
                   14394:                                                $containers{$outer});
                   14395:                     next if ($fatal);
                   14396:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   14397:                         if ($context eq 'coursedocs') {
1.1056    raeburn  14398:                             $mapinner{$i} = time;
1.1055    raeburn  14399:                             $folders{$i} = 'default_'.$mapinner{$i};
                   14400:                             $containers{$i} = 'sequence';
                   14401:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   14402:                                       $folders{$i}.'.'.$containers{$i};
                   14403:                             my $newidx = &LONCAPA::map::getresidx();
                   14404:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  14405:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  14406:                             push(@LONCAPA::map::order,$newidx);
                   14407:                             my ($outtext,$errtext) =
                   14408:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   14409:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  14410:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  14411:                             $newseqid{$i} = $newidx;
1.1067    raeburn  14412:                             unless ($errtext) {
1.1294    raeburn  14413:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',
                   14414:                                                        &HTML::Entities::encode($docstitle,'<>&"')).
                   14415:                                             '</li>'."\n";
1.1067    raeburn  14416:                             }
1.1055    raeburn  14417:                         }
                   14418:                     } else {
                   14419:                         if ($context eq 'coursedocs') {
                   14420:                             my $newidx=&LONCAPA::map::getresidx();
                   14421:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   14422:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   14423:                                       $title;
1.1392    raeburn  14424:                             if (($outer !~ /\D/) &&
                   14425:                                 (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
                   14426:                                 ($newidx !~ /\D/)) {
1.1294    raeburn  14427:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   14428:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   14429:                                 }
                   14430:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   14431:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   14432:                                 }
                   14433:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   14434:                                     if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
                   14435:                                         $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                   14436:                                         unless ($ishome) {
                   14437:                                             my $fetch = "$newdest{$i}/$title";
                   14438:                                             $fetch =~ s/^\Q$prefix$dir\E//;
                   14439:                                             $prompttofetch{$fetch} = 1;
                   14440:                                         }
1.1292    raeburn  14441:                                     }
1.1067    raeburn  14442:                                 }
1.1294    raeburn  14443:                                 $LONCAPA::map::resources[$newidx]=
                   14444:                                     $docstitle.':'.$url.':false:normal:res';
                   14445:                                 push(@LONCAPA::map::order, $newidx);
                   14446:                                 my ($outtext,$errtext)=
                   14447:                                     &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   14448:                                                             $docuname.'/'.$folders{$outer}.
                   14449:                                                             '.'.$containers{$outer},1,1);
                   14450:                                 unless ($errtext) {
                   14451:                                     if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   14452:                                         $result .= '<li>'.&mt('File: [_1] added to course',
                   14453:                                                               &HTML::Entities::encode($docstitle,'<>&"')).
                   14454:                                                    '</li>'."\n";
                   14455:                                     }
1.1067    raeburn  14456:                                 }
1.1294    raeburn  14457:                             } else {
                   14458:                                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   14459:                                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296    raeburn  14460:                             }
1.1055    raeburn  14461:                         }
                   14462:                     }
1.1086    raeburn  14463:                 }
                   14464:             } else {
1.1294    raeburn  14465:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   14466:                                 &HTML::Entities::encode($path,'<>&"')).'<br />'; 
1.1086    raeburn  14467:             }
                   14468:         }
                   14469:         for (my $i=1; $i<=$numitems; $i++) {
                   14470:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   14471:             my $path = $env{'form.archive_content_'.$i};
                   14472:             if ($path =~ /^\Q$pathtocheck\E/) {
                   14473:                 my ($title) = ($path =~ m{/([^/]+)$});
                   14474:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   14475:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   14476:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   14477:                         my ($itemidx,$fullpath,$relpath);
                   14478:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   14479:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  14480:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  14481:                                 if ($dirorder{$i}->[$j] eq $container) {
                   14482:                                     $itemidx = $j;
1.1056    raeburn  14483:                                 }
                   14484:                             }
1.1086    raeburn  14485:                         }
                   14486:                         if ($itemidx eq '') {
                   14487:                             $itemidx =  0;
                   14488:                         } 
                   14489:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   14490:                             if ($mapinner{$referrer{$i}}) {
                   14491:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   14492:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   14493:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   14494:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   14495:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14496:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14497:                                             if (!-e $fullpath) {
                   14498:                                                 mkdir($fullpath,0755);
1.1056    raeburn  14499:                                             }
                   14500:                                         }
1.1086    raeburn  14501:                                     } else {
                   14502:                                         last;
1.1056    raeburn  14503:                                     }
1.1086    raeburn  14504:                                 }
                   14505:                             }
                   14506:                         } elsif ($newdest{$referrer{$i}}) {
                   14507:                             $fullpath = $newdest{$referrer{$i}};
                   14508:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   14509:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   14510:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   14511:                                     last;
                   14512:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   14513:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   14514:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14515:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14516:                                         if (!-e $fullpath) {
                   14517:                                             mkdir($fullpath,0755);
1.1056    raeburn  14518:                                         }
                   14519:                                     }
1.1086    raeburn  14520:                                 } else {
                   14521:                                     last;
1.1056    raeburn  14522:                                 }
1.1055    raeburn  14523:                             }
                   14524:                         }
1.1086    raeburn  14525:                         if ($fullpath ne '') {
                   14526:                             if (-e "$prefix$path") {
1.1292    raeburn  14527:                                 unless (rename("$prefix$path","$fullpath/$title")) {
                   14528:                                      $warning .= &mt('Failed to rename dependency').'<br />';
                   14529:                                 }
1.1086    raeburn  14530:                             }
                   14531:                             if (-e "$fullpath/$title") {
                   14532:                                 my $showpath;
                   14533:                                 if ($relpath ne '') {
                   14534:                                     $showpath = "$relpath/$title";
                   14535:                                 } else {
                   14536:                                     $showpath = "/$title";
                   14537:                                 } 
1.1294    raeburn  14538:                                 $result .= '<li>'.&mt('[_1] included as a dependency',
                   14539:                                                       &HTML::Entities::encode($showpath,'<>&"')).
                   14540:                                            '</li>'."\n";
1.1292    raeburn  14541:                                 unless ($ishome) {
                   14542:                                     my $fetch = "$fullpath/$title";
                   14543:                                     $fetch =~ s/^\Q$prefix$dir\E//; 
                   14544:                                     $prompttofetch{$fetch} = 1;
                   14545:                                 }
1.1086    raeburn  14546:                             }
                   14547:                         }
1.1055    raeburn  14548:                     }
1.1086    raeburn  14549:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   14550:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294    raeburn  14551:                                     &HTML::Entities::encode($path,'<>&"'),
                   14552:                                     &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
                   14553:                                 '<br />';
1.1055    raeburn  14554:                 }
                   14555:             } else {
1.1294    raeburn  14556:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296    raeburn  14557:                                 &HTML::Entities::encode($path)).'<br />';
1.1055    raeburn  14558:             }
                   14559:         }
                   14560:         if (keys(%todelete)) {
                   14561:             foreach my $key (keys(%todelete)) {
                   14562:                 unlink($key);
1.1066    raeburn  14563:             }
                   14564:         }
                   14565:         if (keys(%todeletedir)) {
                   14566:             foreach my $key (keys(%todeletedir)) {
                   14567:                 rmdir($key);
                   14568:             }
                   14569:         }
                   14570:         foreach my $dir (sort(keys(%is_dir))) {
                   14571:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   14572:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  14573:             }
                   14574:         }
1.1067    raeburn  14575:         if ($result ne '') {
                   14576:             $output .= '<ul>'."\n".
                   14577:                        $result."\n".
                   14578:                        '</ul>';
                   14579:         }
                   14580:         unless ($ishome) {
                   14581:             my $replicationfail;
                   14582:             foreach my $item (keys(%prompttofetch)) {
                   14583:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   14584:                 unless ($fetchresult eq 'ok') {
                   14585:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   14586:                 }
                   14587:             }
                   14588:             if ($replicationfail) {
                   14589:                 $output .= '<p class="LC_error">'.
                   14590:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   14591:                            $replicationfail.
                   14592:                            '</ul></p>';
                   14593:             }
                   14594:         }
1.1055    raeburn  14595:     } else {
                   14596:         $warning = &mt('No items found in archive.');
                   14597:     }
                   14598:     if ($error) {
                   14599:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   14600:                    $error.'</p>'."\n";
                   14601:     }
                   14602:     if ($warning) {
                   14603:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   14604:     }
                   14605:     return $output;
                   14606: }
                   14607: 
1.1066    raeburn  14608: sub cleanup_empty_dirs {
                   14609:     my ($path) = @_;
                   14610:     if (($path ne '') && (-d $path)) {
                   14611:         if (opendir(my $dirh,$path)) {
                   14612:             my @dircontents = grep(!/^\./,readdir($dirh));
                   14613:             my $numitems = 0;
                   14614:             foreach my $item (@dircontents) {
                   14615:                 if (-d "$path/$item") {
1.1111    raeburn  14616:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  14617:                     if (-e "$path/$item") {
                   14618:                         $numitems ++;
                   14619:                     }
                   14620:                 } else {
                   14621:                     $numitems ++;
                   14622:                 }
                   14623:             }
                   14624:             if ($numitems == 0) {
                   14625:                 rmdir($path);
                   14626:             }
                   14627:             closedir($dirh);
                   14628:         }
                   14629:     }
                   14630:     return;
                   14631: }
                   14632: 
1.41      ng       14633: =pod
1.45      matthew  14634: 
1.1162    raeburn  14635: =item * &get_folder_hierarchy()
1.1068    raeburn  14636: 
                   14637: Provides hierarchy of names of folders/sub-folders containing the current
                   14638: item,
                   14639: 
                   14640: Inputs: 3
                   14641:      - $navmap - navmaps object
                   14642: 
                   14643:      - $map - url for map (either the trigger itself, or map containing
                   14644:                            the resource, which is the trigger).
                   14645: 
                   14646:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   14647: 
                   14648: Outputs: 1 @pathitems - array of folder/subfolder names.
                   14649: 
                   14650: =cut
                   14651: 
                   14652: sub get_folder_hierarchy {
                   14653:     my ($navmap,$map,$showitem) = @_;
                   14654:     my @pathitems;
                   14655:     if (ref($navmap)) {
                   14656:         my $mapres = $navmap->getResourceByUrl($map);
                   14657:         if (ref($mapres)) {
                   14658:             my $pcslist = $mapres->map_hierarchy();
                   14659:             if ($pcslist ne '') {
                   14660:                 my @pcs = split(/,/,$pcslist);
                   14661:                 foreach my $pc (@pcs) {
                   14662:                     if ($pc == 1) {
1.1129    raeburn  14663:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  14664:                     } else {
                   14665:                         my $res = $navmap->getByMapPc($pc);
                   14666:                         if (ref($res)) {
                   14667:                             my $title = $res->compTitle();
                   14668:                             $title =~ s/\W+/_/g;
                   14669:                             if ($title ne '') {
                   14670:                                 push(@pathitems,$title);
                   14671:                             }
                   14672:                         }
                   14673:                     }
                   14674:                 }
                   14675:             }
1.1071    raeburn  14676:             if ($showitem) {
                   14677:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  14678:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  14679:                 } else {
                   14680:                     my $maptitle = $mapres->compTitle();
                   14681:                     $maptitle =~ s/\W+/_/g;
                   14682:                     if ($maptitle ne '') {
                   14683:                         push(@pathitems,$maptitle);
                   14684:                     }
1.1068    raeburn  14685:                 }
                   14686:             }
                   14687:         }
                   14688:     }
                   14689:     return @pathitems;
                   14690: }
                   14691: 
                   14692: =pod
                   14693: 
1.1015    raeburn  14694: =item * &get_turnedin_filepath()
                   14695: 
                   14696: Determines path in a user's portfolio file for storage of files uploaded
                   14697: to a specific essayresponse or dropbox item.
                   14698: 
                   14699: Inputs: 3 required + 1 optional.
                   14700: $symb is symb for resource, $uname and $udom are for current user (required).
                   14701: $caller is optional (can be "submission", if routine is called when storing
                   14702: an upoaded file when "Submit Answer" button was pressed).
                   14703: 
                   14704: Returns array containing $path and $multiresp. 
                   14705: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   14706: than one file upload item.  Callers of routine should append partid as a 
                   14707: subdirectory to $path in cases where $multiresp is 1.
                   14708: 
                   14709: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   14710: 
                   14711: =cut
                   14712: 
                   14713: sub get_turnedin_filepath {
                   14714:     my ($symb,$uname,$udom,$caller) = @_;
                   14715:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   14716:     my $turnindir;
                   14717:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   14718:     $turnindir = $userhash{'turnindir'};
                   14719:     my ($path,$multiresp);
                   14720:     if ($turnindir eq '') {
                   14721:         if ($caller eq 'submission') {
                   14722:             $turnindir = &mt('turned in');
                   14723:             $turnindir =~ s/\W+/_/g;
                   14724:             my %newhash = (
                   14725:                             'turnindir' => $turnindir,
                   14726:                           );
                   14727:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   14728:         }
                   14729:     }
                   14730:     if ($turnindir ne '') {
                   14731:         $path = '/'.$turnindir.'/';
                   14732:         my ($multipart,$turnin,@pathitems);
                   14733:         my $navmap = Apache::lonnavmaps::navmap->new();
                   14734:         if (defined($navmap)) {
                   14735:             my $mapres = $navmap->getResourceByUrl($map);
                   14736:             if (ref($mapres)) {
                   14737:                 my $pcslist = $mapres->map_hierarchy();
                   14738:                 if ($pcslist ne '') {
                   14739:                     foreach my $pc (split(/,/,$pcslist)) {
                   14740:                         my $res = $navmap->getByMapPc($pc);
                   14741:                         if (ref($res)) {
                   14742:                             my $title = $res->compTitle();
                   14743:                             $title =~ s/\W+/_/g;
                   14744:                             if ($title ne '') {
1.1149    raeburn  14745:                                 if (($pc > 1) && (length($title) > 12)) {
                   14746:                                     $title = substr($title,0,12);
                   14747:                                 }
1.1015    raeburn  14748:                                 push(@pathitems,$title);
                   14749:                             }
                   14750:                         }
                   14751:                     }
                   14752:                 }
                   14753:                 my $maptitle = $mapres->compTitle();
                   14754:                 $maptitle =~ s/\W+/_/g;
                   14755:                 if ($maptitle ne '') {
1.1149    raeburn  14756:                     if (length($maptitle) > 12) {
                   14757:                         $maptitle = substr($maptitle,0,12);
                   14758:                     }
1.1015    raeburn  14759:                     push(@pathitems,$maptitle);
                   14760:                 }
                   14761:                 unless ($env{'request.state'} eq 'construct') {
                   14762:                     my $res = $navmap->getBySymb($symb);
                   14763:                     if (ref($res)) {
                   14764:                         my $partlist = $res->parts();
                   14765:                         my $totaluploads = 0;
                   14766:                         if (ref($partlist) eq 'ARRAY') {
                   14767:                             foreach my $part (@{$partlist}) {
                   14768:                                 my @types = $res->responseType($part);
                   14769:                                 my @ids = $res->responseIds($part);
                   14770:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   14771:                                     if ($types[$i] eq 'essay') {
                   14772:                                         my $partid = $part.'_'.$ids[$i];
                   14773:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   14774:                                             $totaluploads ++;
                   14775:                                         }
                   14776:                                     }
                   14777:                                 }
                   14778:                             }
                   14779:                             if ($totaluploads > 1) {
                   14780:                                 $multiresp = 1;
                   14781:                             }
                   14782:                         }
                   14783:                     }
                   14784:                 }
                   14785:             } else {
                   14786:                 return;
                   14787:             }
                   14788:         } else {
                   14789:             return;
                   14790:         }
                   14791:         my $restitle=&Apache::lonnet::gettitle($symb);
                   14792:         $restitle =~ s/\W+/_/g;
                   14793:         if ($restitle eq '') {
                   14794:             $restitle = ($resurl =~ m{/[^/]+$});
                   14795:             if ($restitle eq '') {
                   14796:                 $restitle = time;
                   14797:             }
                   14798:         }
1.1149    raeburn  14799:         if (length($restitle) > 12) {
                   14800:             $restitle = substr($restitle,0,12);
                   14801:         }
1.1015    raeburn  14802:         push(@pathitems,$restitle);
                   14803:         $path .= join('/',@pathitems);
                   14804:     }
                   14805:     return ($path,$multiresp);
                   14806: }
                   14807: 
                   14808: =pod
                   14809: 
1.464     albertel 14810: =back
1.41      ng       14811: 
1.112     bowersj2 14812: =head1 CSV Upload/Handling functions
1.38      albertel 14813: 
1.41      ng       14814: =over 4
                   14815: 
1.648     raeburn  14816: =item * &upfile_store($r)
1.41      ng       14817: 
                   14818: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 14819: needs $env{'form.upfile'}
1.41      ng       14820: returns $datatoken to be put into hidden field
                   14821: 
                   14822: =cut
1.31      albertel 14823: 
                   14824: sub upfile_store {
                   14825:     my $r=shift;
1.258     albertel 14826:     $env{'form.upfile'}=~s/\r/\n/gs;
                   14827:     $env{'form.upfile'}=~s/\f/\n/gs;
                   14828:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   14829:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 14830: 
1.1299    raeburn  14831:     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
                   14832:                                      '_enroll_'.$env{'request.course.id'}.'_'.
                   14833:                                      time.'_'.$$);
                   14834:     return if ($datatoken eq '');
                   14835: 
1.31      albertel 14836:     {
1.158     raeburn  14837:         my $datafile = $r->dir_config('lonDaemons').
                   14838:                            '/tmp/'.$datatoken.'.tmp';
1.1317    raeburn  14839:         if ( open(my $fh,'>',$datafile) ) {
1.258     albertel 14840:             print $fh $env{'form.upfile'};
1.158     raeburn  14841:             close($fh);
                   14842:         }
1.31      albertel 14843:     }
                   14844:     return $datatoken;
                   14845: }
                   14846: 
1.56      matthew  14847: =pod
                   14848: 
1.1290    raeburn  14849: =item * &load_tmp_file($r,$datatoken)
1.41      ng       14850: 
                   14851: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290    raeburn  14852: $datatoken is the name to assign to the temporary file.
1.258     albertel 14853: sets $env{'form.upfile'} to the contents of the file
1.41      ng       14854: 
                   14855: =cut
1.31      albertel 14856: 
                   14857: sub load_tmp_file {
1.1290    raeburn  14858:     my ($r,$datatoken) = @_;
                   14859:     return if ($datatoken eq '');
1.31      albertel 14860:     my @studentdata=();
                   14861:     {
1.158     raeburn  14862:         my $studentfile = $r->dir_config('lonDaemons').
1.1290    raeburn  14863:                               '/tmp/'.$datatoken.'.tmp';
1.1317    raeburn  14864:         if ( open(my $fh,'<',$studentfile) ) {
1.158     raeburn  14865:             @studentdata=<$fh>;
                   14866:             close($fh);
                   14867:         }
1.31      albertel 14868:     }
1.258     albertel 14869:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 14870: }
                   14871: 
1.1290    raeburn  14872: sub valid_datatoken {
                   14873:     my ($datatoken) = @_;
1.1325    raeburn  14874:     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290    raeburn  14875:         return $datatoken;
                   14876:     }
                   14877:     return;
                   14878: }
                   14879: 
1.56      matthew  14880: =pod
                   14881: 
1.648     raeburn  14882: =item * &upfile_record_sep()
1.41      ng       14883: 
                   14884: Separate uploaded file into records
                   14885: returns array of records,
1.258     albertel 14886: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       14887: 
                   14888: =cut
1.31      albertel 14889: 
                   14890: sub upfile_record_sep {
1.258     albertel 14891:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 14892:     } else {
1.248     albertel 14893: 	my @records;
1.258     albertel 14894: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 14895: 	    if ($line=~/^\s*$/) { next; }
                   14896: 	    push(@records,$line);
                   14897: 	}
                   14898: 	return @records;
1.31      albertel 14899:     }
                   14900: }
                   14901: 
1.56      matthew  14902: =pod
                   14903: 
1.648     raeburn  14904: =item * &record_sep($record)
1.41      ng       14905: 
1.258     albertel 14906: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       14907: 
                   14908: =cut
                   14909: 
1.263     www      14910: sub takeleft {
                   14911:     my $index=shift;
                   14912:     return substr('0000'.$index,-4,4);
                   14913: }
                   14914: 
1.31      albertel 14915: sub record_sep {
                   14916:     my $record=shift;
                   14917:     my %components=();
1.258     albertel 14918:     if ($env{'form.upfiletype'} eq 'xml') {
                   14919:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 14920:         my $i=0;
1.356     albertel 14921:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 14922:             $field=~s/^(\"|\')//;
                   14923:             $field=~s/(\"|\')$//;
1.263     www      14924:             $components{&takeleft($i)}=$field;
1.31      albertel 14925:             $i++;
                   14926:         }
1.258     albertel 14927:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 14928:         my $i=0;
1.356     albertel 14929:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 14930:             $field=~s/^(\"|\')//;
                   14931:             $field=~s/(\"|\')$//;
1.263     www      14932:             $components{&takeleft($i)}=$field;
1.31      albertel 14933:             $i++;
                   14934:         }
                   14935:     } else {
1.561     www      14936:         my $separator=',';
1.480     banghart 14937:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      14938:             $separator=';';
1.480     banghart 14939:         }
1.31      albertel 14940:         my $i=0;
1.561     www      14941: # the character we are looking for to indicate the end of a quote or a record 
                   14942:         my $looking_for=$separator;
                   14943: # do not add the characters to the fields
                   14944:         my $ignore=0;
                   14945: # we just encountered a separator (or the beginning of the record)
                   14946:         my $just_found_separator=1;
                   14947: # store the field we are working on here
                   14948:         my $field='';
                   14949: # work our way through all characters in record
                   14950:         foreach my $character ($record=~/(.)/g) {
                   14951:             if ($character eq $looking_for) {
                   14952:                if ($character ne $separator) {
                   14953: # Found the end of a quote, again looking for separator
                   14954:                   $looking_for=$separator;
                   14955:                   $ignore=1;
                   14956:                } else {
                   14957: # Found a separator, store away what we got
                   14958:                   $components{&takeleft($i)}=$field;
                   14959: 	          $i++;
                   14960:                   $just_found_separator=1;
                   14961:                   $ignore=0;
                   14962:                   $field='';
                   14963:                }
                   14964:                next;
                   14965:             }
                   14966: # single or double quotation marks after a separator indicate beginning of a quote
                   14967: # we are now looking for the end of the quote and need to ignore separators
                   14968:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   14969:                $looking_for=$character;
                   14970:                next;
                   14971:             }
                   14972: # ignore would be true after we reached the end of a quote
                   14973:             if ($ignore) { next; }
                   14974:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   14975:             $field.=$character;
                   14976:             $just_found_separator=0; 
1.31      albertel 14977:         }
1.561     www      14978: # catch the very last entry, since we never encountered the separator
                   14979:         $components{&takeleft($i)}=$field;
1.31      albertel 14980:     }
                   14981:     return %components;
                   14982: }
                   14983: 
1.144     matthew  14984: ######################################################
                   14985: ######################################################
                   14986: 
1.56      matthew  14987: =pod
                   14988: 
1.648     raeburn  14989: =item * &upfile_select_html()
1.41      ng       14990: 
1.144     matthew  14991: Return HTML code to select a file from the users machine and specify 
                   14992: the file type.
1.41      ng       14993: 
                   14994: =cut
                   14995: 
1.144     matthew  14996: ######################################################
                   14997: ######################################################
1.31      albertel 14998: sub upfile_select_html {
1.144     matthew  14999:     my %Types = (
                   15000:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 15001:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  15002:                  space => &mt('Space separated'),
                   15003:                  tab   => &mt('Tabulator separated'),
                   15004: #                 xml   => &mt('HTML/XML'),
                   15005:                  );
                   15006:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  15007:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  15008:     foreach my $type (sort(keys(%Types))) {
                   15009:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   15010:     }
                   15011:     $Str .= "</select>\n";
                   15012:     return $Str;
1.31      albertel 15013: }
                   15014: 
1.301     albertel 15015: sub get_samples {
                   15016:     my ($records,$toget) = @_;
                   15017:     my @samples=({});
                   15018:     my $got=0;
                   15019:     foreach my $rec (@$records) {
                   15020: 	my %temp = &record_sep($rec);
                   15021: 	if (! grep(/\S/, values(%temp))) { next; }
                   15022: 	if (%temp) {
                   15023: 	    $samples[$got]=\%temp;
                   15024: 	    $got++;
                   15025: 	    if ($got == $toget) { last; }
                   15026: 	}
                   15027:     }
                   15028:     return \@samples;
                   15029: }
                   15030: 
1.144     matthew  15031: ######################################################
                   15032: ######################################################
                   15033: 
1.56      matthew  15034: =pod
                   15035: 
1.648     raeburn  15036: =item * &csv_print_samples($r,$records)
1.41      ng       15037: 
                   15038: Prints a table of sample values from each column uploaded $r is an
                   15039: Apache Request ref, $records is an arrayref from
                   15040: &Apache::loncommon::upfile_record_sep
                   15041: 
                   15042: =cut
                   15043: 
1.144     matthew  15044: ######################################################
                   15045: ######################################################
1.31      albertel 15046: sub csv_print_samples {
                   15047:     my ($r,$records) = @_;
1.662     bisitz   15048:     my $samples = &get_samples($records,5);
1.301     albertel 15049: 
1.594     raeburn  15050:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   15051:               &start_data_table_header_row());
1.356     albertel 15052:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   15053:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  15054:     $r->print(&end_data_table_header_row());
1.301     albertel 15055:     foreach my $hash (@$samples) {
1.594     raeburn  15056: 	$r->print(&start_data_table_row());
1.356     albertel 15057: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 15058: 	    $r->print('<td>');
1.356     albertel 15059: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 15060: 	    $r->print('</td>');
                   15061: 	}
1.594     raeburn  15062: 	$r->print(&end_data_table_row());
1.31      albertel 15063:     }
1.594     raeburn  15064:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 15065: }
                   15066: 
1.144     matthew  15067: ######################################################
                   15068: ######################################################
                   15069: 
1.56      matthew  15070: =pod
                   15071: 
1.648     raeburn  15072: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       15073: 
                   15074: Prints a table to create associations between values and table columns.
1.144     matthew  15075: 
1.41      ng       15076: $r is an Apache Request ref,
                   15077: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  15078: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       15079: 
                   15080: =cut
                   15081: 
1.144     matthew  15082: ######################################################
                   15083: ######################################################
1.31      albertel 15084: sub csv_print_select_table {
                   15085:     my ($r,$records,$d) = @_;
1.301     albertel 15086:     my $i=0;
                   15087:     my $samples = &get_samples($records,1);
1.144     matthew  15088:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  15089: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  15090:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  15091:               '<th>'.&mt('Column').'</th>'.
                   15092:               &end_data_table_header_row()."\n");
1.356     albertel 15093:     foreach my $array_ref (@$d) {
                   15094: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  15095: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 15096: 
1.875     bisitz   15097: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  15098: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 15099: 	$r->print('<option value="none"></option>');
1.356     albertel 15100: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   15101: 	    $r->print('<option value="'.$sample.'"'.
                   15102:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   15103:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 15104: 	}
1.594     raeburn  15105: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 15106: 	$i++;
                   15107:     }
1.594     raeburn  15108:     $r->print(&end_data_table());
1.31      albertel 15109:     $i--;
                   15110:     return $i;
                   15111: }
1.56      matthew  15112: 
1.144     matthew  15113: ######################################################
                   15114: ######################################################
                   15115: 
1.56      matthew  15116: =pod
1.31      albertel 15117: 
1.648     raeburn  15118: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       15119: 
                   15120: Prints a table of sample values from the upload and can make associate samples to internal names.
                   15121: 
                   15122: $r is an Apache Request ref,
                   15123: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   15124: $d is an array of 2 element arrays (internal name, displayed name)
                   15125: 
                   15126: =cut
                   15127: 
1.144     matthew  15128: ######################################################
                   15129: ######################################################
1.31      albertel 15130: sub csv_samples_select_table {
                   15131:     my ($r,$records,$d) = @_;
                   15132:     my $i=0;
1.144     matthew  15133:     #
1.662     bisitz   15134:     my $max_samples = 5;
                   15135:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  15136:     $r->print(&start_data_table().
                   15137:               &start_data_table_header_row().'<th>'.
                   15138:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   15139:               &end_data_table_header_row());
1.301     albertel 15140: 
                   15141:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  15142: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  15143: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 15144: 	foreach my $option (@$d) {
                   15145: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  15146: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 15147:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  15148:                       $display.'</option>');
1.31      albertel 15149: 	}
                   15150: 	$r->print('</select></td><td>');
1.662     bisitz   15151: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 15152: 	    if (defined($samples->[$line]{$key})) { 
                   15153: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   15154: 	    }
                   15155: 	}
1.594     raeburn  15156: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 15157: 	$i++;
                   15158:     }
1.594     raeburn  15159:     $r->print(&end_data_table());
1.31      albertel 15160:     $i--;
                   15161:     return($i);
1.115     matthew  15162: }
                   15163: 
1.144     matthew  15164: ######################################################
                   15165: ######################################################
                   15166: 
1.115     matthew  15167: =pod
                   15168: 
1.648     raeburn  15169: =item * &clean_excel_name($name)
1.115     matthew  15170: 
                   15171: Returns a replacement for $name which does not contain any illegal characters.
                   15172: 
                   15173: =cut
                   15174: 
1.144     matthew  15175: ######################################################
                   15176: ######################################################
1.115     matthew  15177: sub clean_excel_name {
                   15178:     my ($name) = @_;
                   15179:     $name =~ s/[:\*\?\/\\]//g;
                   15180:     if (length($name) > 31) {
                   15181:         $name = substr($name,0,31);
                   15182:     }
                   15183:     return $name;
1.25      albertel 15184: }
1.84      albertel 15185: 
1.85      albertel 15186: =pod
                   15187: 
1.648     raeburn  15188: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 15189: 
                   15190: Returns either 1 or undef
                   15191: 
                   15192: 1 if the part is to be hidden, undef if it is to be shown
                   15193: 
                   15194: Arguments are:
                   15195: 
                   15196: $id the id of the part to be checked
                   15197: $symb, optional the symb of the resource to check
                   15198: $udom, optional the domain of the user to check for
                   15199: $uname, optional the username of the user to check for
                   15200: 
                   15201: =cut
1.84      albertel 15202: 
                   15203: sub check_if_partid_hidden {
                   15204:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 15205:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 15206: 					 $symb,$udom,$uname);
1.141     albertel 15207:     my $truth=1;
                   15208:     #if the string starts with !, then the list is the list to show not hide
                   15209:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 15210:     my @hiddenlist=split(/,/,$hiddenparts);
                   15211:     foreach my $checkid (@hiddenlist) {
1.141     albertel 15212: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 15213:     }
1.141     albertel 15214:     return !$truth;
1.84      albertel 15215: }
1.127     matthew  15216: 
1.138     matthew  15217: 
                   15218: ############################################################
                   15219: ############################################################
                   15220: 
                   15221: =pod
                   15222: 
1.157     matthew  15223: =back 
                   15224: 
1.138     matthew  15225: =head1 cgi-bin script and graphing routines
                   15226: 
1.157     matthew  15227: =over 4
                   15228: 
1.648     raeburn  15229: =item * &get_cgi_id()
1.138     matthew  15230: 
                   15231: Inputs: none
                   15232: 
                   15233: Returns an id which can be used to pass environment variables
                   15234: to various cgi-bin scripts.  These environment variables will
                   15235: be removed from the users environment after a given time by
                   15236: the routine &Apache::lonnet::transfer_profile_to_env.
                   15237: 
                   15238: =cut
                   15239: 
                   15240: ############################################################
                   15241: ############################################################
1.152     albertel 15242: my $uniq=0;
1.136     matthew  15243: sub get_cgi_id {
1.154     albertel 15244:     $uniq=($uniq+1)%100000;
1.280     albertel 15245:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  15246: }
                   15247: 
1.127     matthew  15248: ############################################################
                   15249: ############################################################
                   15250: 
                   15251: =pod
                   15252: 
1.648     raeburn  15253: =item * &DrawBarGraph()
1.127     matthew  15254: 
1.138     matthew  15255: Facilitates the plotting of data in a (stacked) bar graph.
                   15256: Puts plot definition data into the users environment in order for 
                   15257: graph.png to plot it.  Returns an <img> tag for the plot.
                   15258: The bars on the plot are labeled '1','2',...,'n'.
                   15259: 
                   15260: Inputs:
                   15261: 
                   15262: =over 4
                   15263: 
                   15264: =item $Title: string, the title of the plot
                   15265: 
                   15266: =item $xlabel: string, text describing the X-axis of the plot
                   15267: 
                   15268: =item $ylabel: string, text describing the Y-axis of the plot
                   15269: 
                   15270: =item $Max: scalar, the maximum Y value to use in the plot
                   15271: If $Max is < any data point, the graph will not be rendered.
                   15272: 
1.140     matthew  15273: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  15274: they are plotted.  If undefined, default values will be used.
                   15275: 
1.178     matthew  15276: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   15277: 
1.138     matthew  15278: =item @Values: An array of array references.  Each array reference holds data
                   15279: to be plotted in a stacked bar chart.
                   15280: 
1.239     matthew  15281: =item If the final element of @Values is a hash reference the key/value
                   15282: pairs will be added to the graph definition.
                   15283: 
1.138     matthew  15284: =back
                   15285: 
                   15286: Returns:
                   15287: 
                   15288: An <img> tag which references graph.png and the appropriate identifying
                   15289: information for the plot.
                   15290: 
1.127     matthew  15291: =cut
                   15292: 
                   15293: ############################################################
                   15294: ############################################################
1.134     matthew  15295: sub DrawBarGraph {
1.178     matthew  15296:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  15297:     #
                   15298:     if (! defined($colors)) {
                   15299:         $colors = ['#33ff00', 
                   15300:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   15301:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   15302:                   ]; 
                   15303:     }
1.228     matthew  15304:     my $extra_settings = {};
                   15305:     if (ref($Values[-1]) eq 'HASH') {
                   15306:         $extra_settings = pop(@Values);
                   15307:     }
1.127     matthew  15308:     #
1.136     matthew  15309:     my $identifier = &get_cgi_id();
                   15310:     my $id = 'cgi.'.$identifier;        
1.129     matthew  15311:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  15312:         return '';
                   15313:     }
1.225     matthew  15314:     #
                   15315:     my @Labels;
                   15316:     if (defined($labels)) {
                   15317:         @Labels = @$labels;
                   15318:     } else {
                   15319:         for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263    raeburn  15320:             push(@Labels,$i+1);
1.225     matthew  15321:         }
                   15322:     }
                   15323:     #
1.129     matthew  15324:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  15325:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  15326:     my %ValuesHash;
                   15327:     my $NumSets=1;
                   15328:     foreach my $array (@Values) {
                   15329:         next if (! ref($array));
1.136     matthew  15330:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  15331:             join(',',@$array);
1.129     matthew  15332:     }
1.127     matthew  15333:     #
1.136     matthew  15334:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  15335:     if ($NumBars < 3) {
                   15336:         $width = 120+$NumBars*32;
1.220     matthew  15337:         $xskip = 1;
1.225     matthew  15338:         $bar_width = 30;
                   15339:     } elsif ($NumBars < 5) {
                   15340:         $width = 120+$NumBars*20;
                   15341:         $xskip = 1;
                   15342:         $bar_width = 20;
1.220     matthew  15343:     } elsif ($NumBars < 10) {
1.136     matthew  15344:         $width = 120+$NumBars*15;
                   15345:         $xskip = 1;
                   15346:         $bar_width = 15;
                   15347:     } elsif ($NumBars <= 25) {
                   15348:         $width = 120+$NumBars*11;
                   15349:         $xskip = 5;
                   15350:         $bar_width = 8;
                   15351:     } elsif ($NumBars <= 50) {
                   15352:         $width = 120+$NumBars*8;
                   15353:         $xskip = 5;
                   15354:         $bar_width = 4;
                   15355:     } else {
                   15356:         $width = 120+$NumBars*8;
                   15357:         $xskip = 5;
                   15358:         $bar_width = 4;
                   15359:     }
                   15360:     #
1.137     matthew  15361:     $Max = 1 if ($Max < 1);
                   15362:     if ( int($Max) < $Max ) {
                   15363:         $Max++;
                   15364:         $Max = int($Max);
                   15365:     }
1.127     matthew  15366:     $Title  = '' if (! defined($Title));
                   15367:     $xlabel = '' if (! defined($xlabel));
                   15368:     $ylabel = '' if (! defined($ylabel));
1.369     www      15369:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   15370:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   15371:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  15372:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  15373:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   15374:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   15375:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   15376:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15377:     $ValuesHash{$id.'.height'}   = $height;
                   15378:     $ValuesHash{$id.'.width'}    = $width;
                   15379:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   15380:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   15381:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  15382:     #
1.228     matthew  15383:     # Deal with other parameters
                   15384:     while (my ($key,$value) = each(%$extra_settings)) {
                   15385:         $ValuesHash{$id.'.'.$key} = $value;
                   15386:     }
                   15387:     #
1.646     raeburn  15388:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  15389:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   15390: }
                   15391: 
                   15392: ############################################################
                   15393: ############################################################
                   15394: 
                   15395: =pod
                   15396: 
1.648     raeburn  15397: =item * &DrawXYGraph()
1.137     matthew  15398: 
1.138     matthew  15399: Facilitates the plotting of data in an XY graph.
                   15400: Puts plot definition data into the users environment in order for 
                   15401: graph.png to plot it.  Returns an <img> tag for the plot.
                   15402: 
                   15403: Inputs:
                   15404: 
                   15405: =over 4
                   15406: 
                   15407: =item $Title: string, the title of the plot
                   15408: 
                   15409: =item $xlabel: string, text describing the X-axis of the plot
                   15410: 
                   15411: =item $ylabel: string, text describing the Y-axis of the plot
                   15412: 
                   15413: =item $Max: scalar, the maximum Y value to use in the plot
                   15414: If $Max is < any data point, the graph will not be rendered.
                   15415: 
                   15416: =item $colors: Array ref containing the hex color codes for the data to be 
                   15417: plotted in.  If undefined, default values will be used.
                   15418: 
                   15419: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   15420: 
                   15421: =item $Ydata: Array ref containing Array refs.  
1.185     www      15422: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  15423: 
                   15424: =item %Values: hash indicating or overriding any default values which are 
                   15425: passed to graph.png.  
                   15426: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   15427: 
                   15428: =back
                   15429: 
                   15430: Returns:
                   15431: 
                   15432: An <img> tag which references graph.png and the appropriate identifying
                   15433: information for the plot.
                   15434: 
1.137     matthew  15435: =cut
                   15436: 
                   15437: ############################################################
                   15438: ############################################################
                   15439: sub DrawXYGraph {
                   15440:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   15441:     #
                   15442:     # Create the identifier for the graph
                   15443:     my $identifier = &get_cgi_id();
                   15444:     my $id = 'cgi.'.$identifier;
                   15445:     #
                   15446:     $Title  = '' if (! defined($Title));
                   15447:     $xlabel = '' if (! defined($xlabel));
                   15448:     $ylabel = '' if (! defined($ylabel));
                   15449:     my %ValuesHash = 
                   15450:         (
1.369     www      15451:          $id.'.title'  => &escape($Title),
                   15452:          $id.'.xlabel' => &escape($xlabel),
                   15453:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  15454:          $id.'.y_max_value'=> $Max,
                   15455:          $id.'.labels'     => join(',',@$Xlabels),
                   15456:          $id.'.PlotType'   => 'XY',
                   15457:          );
                   15458:     #
                   15459:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   15460:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15461:     }
                   15462:     #
                   15463:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   15464:         return '';
                   15465:     }
                   15466:     my $NumSets=1;
1.138     matthew  15467:     foreach my $array (@{$Ydata}){
1.137     matthew  15468:         next if (! ref($array));
                   15469:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   15470:     }
1.138     matthew  15471:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  15472:     #
                   15473:     # Deal with other parameters
                   15474:     while (my ($key,$value) = each(%Values)) {
                   15475:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  15476:     }
                   15477:     #
1.646     raeburn  15478:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  15479:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   15480: }
                   15481: 
                   15482: ############################################################
                   15483: ############################################################
                   15484: 
                   15485: =pod
                   15486: 
1.648     raeburn  15487: =item * &DrawXYYGraph()
1.138     matthew  15488: 
                   15489: Facilitates the plotting of data in an XY graph with two Y axes.
                   15490: Puts plot definition data into the users environment in order for 
                   15491: graph.png to plot it.  Returns an <img> tag for the plot.
                   15492: 
                   15493: Inputs:
                   15494: 
                   15495: =over 4
                   15496: 
                   15497: =item $Title: string, the title of the plot
                   15498: 
                   15499: =item $xlabel: string, text describing the X-axis of the plot
                   15500: 
                   15501: =item $ylabel: string, text describing the Y-axis of the plot
                   15502: 
                   15503: =item $colors: Array ref containing the hex color codes for the data to be 
                   15504: plotted in.  If undefined, default values will be used.
                   15505: 
                   15506: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   15507: 
                   15508: =item $Ydata1: The first data set
                   15509: 
                   15510: =item $Min1: The minimum value of the left Y-axis
                   15511: 
                   15512: =item $Max1: The maximum value of the left Y-axis
                   15513: 
                   15514: =item $Ydata2: The second data set
                   15515: 
                   15516: =item $Min2: The minimum value of the right Y-axis
                   15517: 
                   15518: =item $Max2: The maximum value of the left Y-axis
                   15519: 
                   15520: =item %Values: hash indicating or overriding any default values which are 
                   15521: passed to graph.png.  
                   15522: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   15523: 
                   15524: =back
                   15525: 
                   15526: Returns:
                   15527: 
                   15528: An <img> tag which references graph.png and the appropriate identifying
                   15529: information for the plot.
1.136     matthew  15530: 
                   15531: =cut
                   15532: 
                   15533: ############################################################
                   15534: ############################################################
1.137     matthew  15535: sub DrawXYYGraph {
                   15536:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   15537:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  15538:     #
                   15539:     # Create the identifier for the graph
                   15540:     my $identifier = &get_cgi_id();
                   15541:     my $id = 'cgi.'.$identifier;
                   15542:     #
                   15543:     $Title  = '' if (! defined($Title));
                   15544:     $xlabel = '' if (! defined($xlabel));
                   15545:     $ylabel = '' if (! defined($ylabel));
                   15546:     my %ValuesHash = 
                   15547:         (
1.369     www      15548:          $id.'.title'  => &escape($Title),
                   15549:          $id.'.xlabel' => &escape($xlabel),
                   15550:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  15551:          $id.'.labels' => join(',',@$Xlabels),
                   15552:          $id.'.PlotType' => 'XY',
                   15553:          $id.'.NumSets' => 2,
1.137     matthew  15554:          $id.'.two_axes' => 1,
                   15555:          $id.'.y1_max_value' => $Max1,
                   15556:          $id.'.y1_min_value' => $Min1,
                   15557:          $id.'.y2_max_value' => $Max2,
                   15558:          $id.'.y2_min_value' => $Min2,
1.136     matthew  15559:          );
                   15560:     #
1.137     matthew  15561:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   15562:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15563:     }
                   15564:     #
                   15565:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   15566:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  15567:         return '';
                   15568:     }
                   15569:     my $NumSets=1;
1.137     matthew  15570:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  15571:         next if (! ref($array));
                   15572:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  15573:     }
                   15574:     #
                   15575:     # Deal with other parameters
                   15576:     while (my ($key,$value) = each(%Values)) {
                   15577:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  15578:     }
                   15579:     #
1.646     raeburn  15580:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 15581:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  15582: }
                   15583: 
                   15584: ############################################################
                   15585: ############################################################
                   15586: 
                   15587: =pod
                   15588: 
1.157     matthew  15589: =back 
                   15590: 
1.139     matthew  15591: =head1 Statistics helper routines?  
                   15592: 
                   15593: Bad place for them but what the hell.
                   15594: 
1.157     matthew  15595: =over 4
                   15596: 
1.648     raeburn  15597: =item * &chartlink()
1.139     matthew  15598: 
                   15599: Returns a link to the chart for a specific student.  
                   15600: 
                   15601: Inputs:
                   15602: 
                   15603: =over 4
                   15604: 
                   15605: =item $linktext: The text of the link
                   15606: 
                   15607: =item $sname: The students username
                   15608: 
                   15609: =item $sdomain: The students domain
                   15610: 
                   15611: =back
                   15612: 
1.157     matthew  15613: =back
                   15614: 
1.139     matthew  15615: =cut
                   15616: 
                   15617: ############################################################
                   15618: ############################################################
                   15619: sub chartlink {
                   15620:     my ($linktext, $sname, $sdomain) = @_;
                   15621:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      15622:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 15623:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  15624:        '">'.$linktext.'</a>';
1.153     matthew  15625: }
                   15626: 
                   15627: #######################################################
                   15628: #######################################################
                   15629: 
                   15630: =pod
                   15631: 
                   15632: =head1 Course Environment Routines
1.157     matthew  15633: 
                   15634: =over 4
1.153     matthew  15635: 
1.648     raeburn  15636: =item * &restore_course_settings()
1.153     matthew  15637: 
1.648     raeburn  15638: =item * &store_course_settings()
1.153     matthew  15639: 
                   15640: Restores/Store indicated form parameters from the course environment.
                   15641: Will not overwrite existing values of the form parameters.
                   15642: 
                   15643: Inputs: 
                   15644: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   15645: 
                   15646: a hash ref describing the data to be stored.  For example:
                   15647:    
                   15648: %Save_Parameters = ('Status' => 'scalar',
                   15649:     'chartoutputmode' => 'scalar',
                   15650:     'chartoutputdata' => 'scalar',
                   15651:     'Section' => 'array',
1.373     raeburn  15652:     'Group' => 'array',
1.153     matthew  15653:     'StudentData' => 'array',
                   15654:     'Maps' => 'array');
                   15655: 
                   15656: Returns: both routines return nothing
                   15657: 
1.631     raeburn  15658: =back
                   15659: 
1.153     matthew  15660: =cut
                   15661: 
                   15662: #######################################################
                   15663: #######################################################
                   15664: sub store_course_settings {
1.496     albertel 15665:     return &store_settings($env{'request.course.id'},@_);
                   15666: }
                   15667: 
                   15668: sub store_settings {
1.153     matthew  15669:     # save to the environment
                   15670:     # appenv the same items, just to be safe
1.300     albertel 15671:     my $udom  = $env{'user.domain'};
                   15672:     my $uname = $env{'user.name'};
1.496     albertel 15673:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  15674:     my %SaveHash;
                   15675:     my %AppHash;
                   15676:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 15677:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 15678:         my $envname = 'environment.'.$basename;
1.258     albertel 15679:         if (exists($env{'form.'.$setting})) {
1.153     matthew  15680:             # Save this value away
                   15681:             if ($type eq 'scalar' &&
1.258     albertel 15682:                 (! exists($env{$envname}) || 
                   15683:                  $env{$envname} ne $env{'form.'.$setting})) {
                   15684:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   15685:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  15686:             } elsif ($type eq 'array') {
                   15687:                 my $stored_form;
1.258     albertel 15688:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  15689:                     $stored_form = join(',',
                   15690:                                         map {
1.369     www      15691:                                             &escape($_);
1.258     albertel 15692:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  15693:                 } else {
                   15694:                     $stored_form = 
1.369     www      15695:                         &escape($env{'form.'.$setting});
1.153     matthew  15696:                 }
                   15697:                 # Determine if the array contents are the same.
1.258     albertel 15698:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  15699:                     $SaveHash{$basename} = $stored_form;
                   15700:                     $AppHash{$envname}   = $stored_form;
                   15701:                 }
                   15702:             }
                   15703:         }
                   15704:     }
                   15705:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 15706:                                           $udom,$uname);
1.153     matthew  15707:     if ($put_result !~ /^(ok|delayed)/) {
                   15708:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   15709:                                  'got error:'.$put_result);
                   15710:     }
                   15711:     # Make sure these settings stick around in this session, too
1.646     raeburn  15712:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  15713:     return;
                   15714: }
                   15715: 
                   15716: sub restore_course_settings {
1.499     albertel 15717:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 15718: }
                   15719: 
                   15720: sub restore_settings {
                   15721:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  15722:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 15723:         next if (exists($env{'form.'.$setting}));
1.496     albertel 15724:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  15725:             '.'.$setting;
1.258     albertel 15726:         if (exists($env{$envname})) {
1.153     matthew  15727:             if ($type eq 'scalar') {
1.258     albertel 15728:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  15729:             } elsif ($type eq 'array') {
1.258     albertel 15730:                 $env{'form.'.$setting} = [ 
1.153     matthew  15731:                                            map { 
1.369     www      15732:                                                &unescape($_); 
1.258     albertel 15733:                                            } split(',',$env{$envname})
1.153     matthew  15734:                                            ];
                   15735:             }
                   15736:         }
                   15737:     }
1.127     matthew  15738: }
                   15739: 
1.618     raeburn  15740: #######################################################
                   15741: #######################################################
                   15742: 
                   15743: =pod
                   15744: 
                   15745: =head1 Domain E-mail Routines  
                   15746: 
                   15747: =over 4
                   15748: 
1.648     raeburn  15749: =item * &build_recipient_list()
1.618     raeburn  15750: 
1.1144    raeburn  15751: Build recipient lists for following types of e-mail:
1.766     raeburn  15752: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  15753: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   15754: module change checking, student/employee ID conflict checks, as
                   15755: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   15756: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  15757: 
                   15758: Inputs:
1.619     raeburn  15759: defmail (scalar - email address of default recipient), 
1.1144    raeburn  15760: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   15761: requestsmail, updatesmail, or idconflictsmail).
                   15762: 
1.619     raeburn  15763: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  15764: 
1.619     raeburn  15765: origmail (scalar - email address of recipient from loncapa.conf, 
1.1297    raeburn  15766: i.e., predates configuration by DC via domainprefs.pm
                   15767: 
                   15768: $requname username of requester (if mailing type is helpdeskmail)
                   15769: 
                   15770: $requdom domain of requester (if mailing type is helpdeskmail)
                   15771: 
                   15772: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
                   15773: 
1.618     raeburn  15774: 
1.655     raeburn  15775: Returns: comma separated list of addresses to which to send e-mail.
                   15776: 
                   15777: =back
1.618     raeburn  15778: 
                   15779: =cut
                   15780: 
                   15781: ############################################################
                   15782: ############################################################
                   15783: sub build_recipient_list {
1.1297    raeburn  15784:     my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618     raeburn  15785:     my @recipients;
1.1270    raeburn  15786:     my ($otheremails,$lastresort,$allbcc,$addtext);
1.618     raeburn  15787:     my %domconfig =
1.1270    raeburn  15788:         &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618     raeburn  15789:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  15790:         if (exists($domconfig{'contacts'}{$mailing})) {
                   15791:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   15792:                 my @contacts = ('adminemail','supportemail');
                   15793:                 foreach my $item (@contacts) {
                   15794:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   15795:                         my $addr = $domconfig{'contacts'}{$item}; 
                   15796:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15797:                             push(@recipients,$addr);
                   15798:                         }
1.619     raeburn  15799:                     }
1.1270    raeburn  15800:                 }
                   15801:                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   15802:                 if ($mailing eq 'helpdeskmail') {
                   15803:                     if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                   15804:                         my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                   15805:                         my @ok_bccs;
                   15806:                         foreach my $bcc (@bccs) {
                   15807:                             $bcc =~ s/^\s+//g;
                   15808:                             $bcc =~ s/\s+$//g;
                   15809:                             if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   15810:                                 if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   15811:                                     push(@ok_bccs,$bcc);
                   15812:                                 }
                   15813:                             }
                   15814:                         }
                   15815:                         if (@ok_bccs > 0) {
                   15816:                             $allbcc = join(', ',@ok_bccs);
                   15817:                         }
                   15818:                     }
                   15819:                     $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618     raeburn  15820:                 }
                   15821:             }
1.766     raeburn  15822:         } elsif ($origmail ne '') {
1.1270    raeburn  15823:             $lastresort = $origmail;
1.618     raeburn  15824:         }
1.1297    raeburn  15825:         if ($mailing eq 'helpdeskmail') {
                   15826:             if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
                   15827:                 (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
                   15828:                 my ($inststatus,$inststatus_checked);
                   15829:                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
                   15830:                     ($env{'user.domain'} ne 'public')) {
                   15831:                     $inststatus_checked = 1;
                   15832:                     $inststatus = $env{'environment.inststatus'};
                   15833:                 }
                   15834:                 unless ($inststatus_checked) {
                   15835:                     if (($requname ne '') && ($requdom ne '')) {
                   15836:                         if (($requname =~ /^$match_username$/) &&
                   15837:                             ($requdom =~ /^$match_domain$/) &&
                   15838:                             (&Apache::lonnet::domain($requdom))) {
                   15839:                             my $requhome = &Apache::lonnet::homeserver($requname,
                   15840:                                                                       $requdom);
                   15841:                             unless ($requhome eq 'no_host') {
                   15842:                                 my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
                   15843:                                 $inststatus = $userenv{'inststatus'};
                   15844:                                 $inststatus_checked = 1;
                   15845:                             }
                   15846:                         }
                   15847:                     }
                   15848:                 }
                   15849:                 unless ($inststatus_checked) {
                   15850:                     if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
                   15851:                         my %srch = (srchby     => 'email',
                   15852:                                     srchdomain => $defdom,
                   15853:                                     srchterm   => $reqemail,
                   15854:                                     srchtype   => 'exact');
                   15855:                         my %srch_results = &Apache::lonnet::usersearch(\%srch);
                   15856:                         foreach my $uname (keys(%srch_results)) {
                   15857:                             if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   15858:                                 $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   15859:                                 $inststatus_checked = 1;
                   15860:                                 last;
                   15861:                             }
                   15862:                         }
                   15863:                         unless ($inststatus_checked) {
                   15864:                             my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
                   15865:                             if ($dirsrchres eq 'ok') {
                   15866:                                 foreach my $uname (keys(%srch_results)) {
                   15867:                                     if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   15868:                                         $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   15869:                                         $inststatus_checked = 1;
                   15870:                                         last;
                   15871:                                     }
                   15872:                                 }
                   15873:                             }
                   15874:                         }
                   15875:                     }
                   15876:                 }
                   15877:                 if ($inststatus ne '') {
                   15878:                     foreach my $status (split(/\:/,$inststatus)) {
                   15879:                         if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
                   15880:                             my @contacts = ('adminemail','supportemail');
                   15881:                             foreach my $item (@contacts) {
                   15882:                                 if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
                   15883:                                     my $addr = $domconfig{'contacts'}{'overrides'}{$status};
                   15884:                                     if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15885:                                         push(@recipients,$addr);
                   15886:                                     }
                   15887:                                 }
                   15888:                             }
                   15889:                             $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
                   15890:                             if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
                   15891:                                 my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
                   15892:                                 my @ok_bccs;
                   15893:                                 foreach my $bcc (@bccs) {
                   15894:                                     $bcc =~ s/^\s+//g;
                   15895:                                     $bcc =~ s/\s+$//g;
                   15896:                                     if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   15897:                                         if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   15898:                                             push(@ok_bccs,$bcc);
                   15899:                                         }
                   15900:                                     }
                   15901:                                 }
                   15902:                                 if (@ok_bccs > 0) {
                   15903:                                     $allbcc = join(', ',@ok_bccs);
                   15904:                                 }
                   15905:                             }
                   15906:                             $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
                   15907:                             last;
                   15908:                         }
                   15909:                     }
                   15910:                 }
                   15911:             }
                   15912:         }
1.619     raeburn  15913:     } elsif ($origmail ne '') {
1.1270    raeburn  15914:         $lastresort = $origmail;
                   15915:     }
1.1297    raeburn  15916:     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270    raeburn  15917:         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
                   15918:             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   15919:             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
                   15920:             my %what = (
                   15921:                           perlvar => 1,
                   15922:                        );
                   15923:             my $primary = &Apache::lonnet::domain($defdom,'primary');
                   15924:             if ($primary) {
                   15925:                 my $gotaddr;
                   15926:                 my ($result,$returnhash) =
                   15927:                     &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   15928:                 if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                   15929:                     if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                   15930:                         $lastresort = $returnhash->{'lonSupportEMail'};
                   15931:                         $gotaddr = 1;
                   15932:                     }
                   15933:                 }
                   15934:                 unless ($gotaddr) {
                   15935:                     my $uintdom = &Apache::lonnet::internet_dom($primary);
                   15936:                     my $intdom = &Apache::lonnet::internet_dom($lonhost);
                   15937:                     unless ($uintdom eq $intdom) {
                   15938:                         my %domconfig =
                   15939:                             &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                   15940:                         if (ref($domconfig{'contacts'}) eq 'HASH') {
                   15941:                             if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                   15942:                                 my @contacts = ('adminemail','supportemail');
                   15943:                                 foreach my $item (@contacts) {
                   15944:                                     if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                   15945:                                         my $addr = $domconfig{'contacts'}{$item};
                   15946:                                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15947:                                             push(@recipients,$addr);
                   15948:                                         }
                   15949:                                     }
                   15950:                                 }
                   15951:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                   15952:                                     $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                   15953:                                 }
                   15954:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                   15955:                                     my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                   15956:                                     my @ok_bccs;
                   15957:                                     foreach my $bcc (@bccs) {
                   15958:                                         $bcc =~ s/^\s+//g;
                   15959:                                         $bcc =~ s/\s+$//g;
                   15960:                                         if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   15961:                                             if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   15962:                                                 push(@ok_bccs,$bcc);
                   15963:                                             }
                   15964:                                         }
                   15965:                                     }
                   15966:                                     if (@ok_bccs > 0) {
                   15967:                                         $allbcc = join(', ',@ok_bccs);
                   15968:                                     }
                   15969:                                 }
                   15970:                                 $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                   15971:                             }
                   15972:                         }
                   15973:                     }
                   15974:                 }
                   15975:             }
                   15976:         }
1.618     raeburn  15977:     }
1.688     raeburn  15978:     if (defined($defmail)) {
                   15979:         if ($defmail ne '') {
                   15980:             push(@recipients,$defmail);
                   15981:         }
1.618     raeburn  15982:     }
                   15983:     if ($otheremails) {
1.619     raeburn  15984:         my @others;
                   15985:         if ($otheremails =~ /,/) {
                   15986:             @others = split(/,/,$otheremails);
1.618     raeburn  15987:         } else {
1.619     raeburn  15988:             push(@others,$otheremails);
                   15989:         }
                   15990:         foreach my $addr (@others) {
                   15991:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15992:                 push(@recipients,$addr);
                   15993:             }
1.618     raeburn  15994:         }
                   15995:     }
1.1298    raeburn  15996:     if ($mailing eq 'helpdeskmail') {
1.1270    raeburn  15997:         if ((!@recipients) && ($lastresort ne '')) {
                   15998:             push(@recipients,$lastresort);
                   15999:         }
                   16000:     } elsif ($lastresort ne '') {
                   16001:         if (!grep(/^\Q$lastresort\E$/,@recipients)) {
                   16002:             push(@recipients,$lastresort);
                   16003:         }
                   16004:     }
1.1271    raeburn  16005:     my $recipientlist = join(',',@recipients);
1.1270    raeburn  16006:     if (wantarray) {
                   16007:         return ($recipientlist,$allbcc,$addtext);
                   16008:     } else {
                   16009:         return $recipientlist;
                   16010:     }
1.618     raeburn  16011: }
                   16012: 
1.127     matthew  16013: ############################################################
                   16014: ############################################################
1.154     albertel 16015: 
1.655     raeburn  16016: =pod
                   16017: 
1.1224    musolffc 16018: =over 4
                   16019: 
1.1223    musolffc 16020: =item * &mime_email()
                   16021: 
                   16022: Sends an email with a possible attachment
                   16023: 
                   16024: Inputs:
                   16025: 
                   16026: =over 4
                   16027: 
                   16028: from -              Sender's email address
                   16029: 
1.1343    raeburn  16030: replyto -           Reply-To email address
                   16031: 
1.1223    musolffc 16032: to -                Email address of recipient
                   16033: 
                   16034: subject -           Subject of email
                   16035: 
                   16036: body -              Body of email
                   16037: 
                   16038: cc_string -         Carbon copy email address
                   16039: 
                   16040: bcc -               Blind carbon copy email address
                   16041: 
                   16042: attachment_path -   Path of file to be attached
                   16043: 
                   16044: file_name -         Name of file to be attached
                   16045: 
                   16046: attachment_text -   The body of an attachment of type "TEXT"
                   16047: 
                   16048: =back
                   16049: 
                   16050: =back
                   16051: 
                   16052: =cut
                   16053: 
                   16054: ############################################################
                   16055: ############################################################
                   16056: 
                   16057: sub mime_email {
1.1343    raeburn  16058:     my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, 
                   16059:         $file_name,$attachment_text) = @_;
                   16060:  
1.1223    musolffc 16061:     my $msg = MIME::Lite->new(
                   16062:              From    => $from,
                   16063:              To      => $to,
                   16064:              Subject => $subject,
                   16065:              Type    =>'TEXT',
                   16066:              Data    => $body,
                   16067:              );
1.1343    raeburn  16068:     if ($replyto ne '') {
                   16069:         $msg->add("Reply-To" => $replyto);
                   16070:     }
1.1223    musolffc 16071:     if ($cc_string ne '') {
                   16072:         $msg->add("Cc" => $cc_string);
                   16073:     }
                   16074:     if ($bcc ne '') {
                   16075:         $msg->add("Bcc" => $bcc);
                   16076:     }
                   16077:     $msg->attr("content-type"         => "text/plain");
                   16078:     $msg->attr("content-type.charset" => "UTF-8");
                   16079:     # Attach file if given
                   16080:     if ($attachment_path) {
                   16081:         unless ($file_name) {
                   16082:             if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
                   16083:         }
                   16084:         my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
                   16085:         $msg->attach(Type     => $type,
                   16086:                      Path     => $attachment_path,
                   16087:                      Filename => $file_name
                   16088:                      );
                   16089:     # Otherwise attach text if given
                   16090:     } elsif ($attachment_text) {
                   16091:         $msg->attach(Type => 'TEXT',
                   16092:                      Data => $attachment_text);
                   16093:     }
                   16094:     # Send it
                   16095:     $msg->send('sendmail');
                   16096: }
                   16097: 
                   16098: ############################################################
                   16099: ############################################################
                   16100: 
                   16101: =pod
                   16102: 
1.655     raeburn  16103: =head1 Course Catalog Routines
                   16104: 
                   16105: =over 4
                   16106: 
                   16107: =item * &gather_categories()
                   16108: 
                   16109: Converts category definitions - keys of categories hash stored in  
                   16110: coursecategories in configuration.db on the primary library server in a 
                   16111: domain - to an array.  Also generates javascript and idx hash used to 
                   16112: generate Domain Coordinator interface for editing Course Categories.
                   16113: 
                   16114: Inputs:
1.663     raeburn  16115: 
1.655     raeburn  16116: categories (reference to hash of category definitions).
1.663     raeburn  16117: 
1.655     raeburn  16118: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   16119:       categories and subcategories).
1.663     raeburn  16120: 
1.655     raeburn  16121: idx (reference to hash of counters used in Domain Coordinator interface for 
                   16122:       editing Course Categories).
1.663     raeburn  16123: 
1.655     raeburn  16124: jsarray (reference to array of categories used to create Javascript arrays for
                   16125:          Domain Coordinator interface for editing Course Categories).
                   16126: 
                   16127: Returns: nothing
                   16128: 
                   16129: Side effects: populates cats, idx and jsarray. 
                   16130: 
                   16131: =cut
                   16132: 
                   16133: sub gather_categories {
                   16134:     my ($categories,$cats,$idx,$jsarray) = @_;
                   16135:     my %counters;
                   16136:     my $num = 0;
                   16137:     foreach my $item (keys(%{$categories})) {
                   16138:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   16139:         if ($container eq '' && $depth == 0) {
                   16140:             $cats->[$depth][$categories->{$item}] = $cat;
                   16141:         } else {
                   16142:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   16143:         }
                   16144:         my ($escitem,$tail) = split(/:/,$item,2);
                   16145:         if ($counters{$tail} eq '') {
                   16146:             $counters{$tail} = $num;
                   16147:             $num ++;
                   16148:         }
                   16149:         if (ref($idx) eq 'HASH') {
                   16150:             $idx->{$item} = $counters{$tail};
                   16151:         }
                   16152:         if (ref($jsarray) eq 'ARRAY') {
                   16153:             push(@{$jsarray->[$counters{$tail}]},$item);
                   16154:         }
                   16155:     }
                   16156:     return;
                   16157: }
                   16158: 
                   16159: =pod
                   16160: 
                   16161: =item * &extract_categories()
                   16162: 
                   16163: Used to generate breadcrumb trails for course categories.
                   16164: 
                   16165: Inputs:
1.663     raeburn  16166: 
1.655     raeburn  16167: categories (reference to hash of category definitions).
1.663     raeburn  16168: 
1.655     raeburn  16169: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   16170:       categories and subcategories).
1.663     raeburn  16171: 
1.655     raeburn  16172: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  16173: 
1.655     raeburn  16174: allitems (reference to hash - key is category key 
                   16175:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  16176: 
1.655     raeburn  16177: idx (reference to hash of counters used in Domain Coordinator interface for
                   16178:       editing Course Categories).
1.663     raeburn  16179: 
1.655     raeburn  16180: jsarray (reference to array of categories used to create Javascript arrays for
                   16181:          Domain Coordinator interface for editing Course Categories).
                   16182: 
1.665     raeburn  16183: subcats (reference to hash of arrays containing all subcategories within each 
                   16184:          category, -recursive)
                   16185: 
1.1321    raeburn  16186: maxd (reference to hash used to hold max depth for all top-level categories).
                   16187: 
1.655     raeburn  16188: Returns: nothing
                   16189: 
                   16190: Side effects: populates trails and allitems hash references.
                   16191: 
                   16192: =cut
                   16193: 
                   16194: sub extract_categories {
1.1321    raeburn  16195:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655     raeburn  16196:     if (ref($categories) eq 'HASH') {
                   16197:         &gather_categories($categories,$cats,$idx,$jsarray);
                   16198:         if (ref($cats->[0]) eq 'ARRAY') {
                   16199:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   16200:                 my $name = $cats->[0][$i];
                   16201:                 my $item = &escape($name).'::0';
                   16202:                 my $trailstr;
                   16203:                 if ($name eq 'instcode') {
                   16204:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  16205:                 } elsif ($name eq 'communities') {
                   16206:                     $trailstr = &mt('Communities');
1.1239    raeburn  16207:                 } elsif ($name eq 'placement') {
                   16208:                     $trailstr = &mt('Placement Tests');
1.655     raeburn  16209:                 } else {
                   16210:                     $trailstr = $name;
                   16211:                 }
                   16212:                 if ($allitems->{$item} eq '') {
                   16213:                     push(@{$trails},$trailstr);
                   16214:                     $allitems->{$item} = scalar(@{$trails})-1;
                   16215:                 }
                   16216:                 my @parents = ($name);
                   16217:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   16218:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   16219:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  16220:                         if (ref($subcats) eq 'HASH') {
                   16221:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   16222:                         }
1.1321    raeburn  16223:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665     raeburn  16224:                     }
                   16225:                 } else {
                   16226:                     if (ref($subcats) eq 'HASH') {
                   16227:                         $subcats->{$item} = [];
1.655     raeburn  16228:                     }
1.1321    raeburn  16229:                     if (ref($maxd) eq 'HASH') {
                   16230:                         $maxd->{$name} = 1;
                   16231:                     }
1.655     raeburn  16232:                 }
                   16233:             }
                   16234:         }
                   16235:     }
                   16236:     return;
                   16237: }
                   16238: 
                   16239: =pod
                   16240: 
1.1162    raeburn  16241: =item * &recurse_categories()
1.655     raeburn  16242: 
                   16243: Recursively used to generate breadcrumb trails for course categories.
                   16244: 
                   16245: Inputs:
1.663     raeburn  16246: 
1.655     raeburn  16247: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   16248:       categories and subcategories).
1.663     raeburn  16249: 
1.655     raeburn  16250: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  16251: 
                   16252: category (current course category, for which breadcrumb trail is being generated).
                   16253: 
                   16254: trails (reference to array of breadcrumb trails for each category).
                   16255: 
1.655     raeburn  16256: allitems (reference to hash - key is category key
                   16257:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  16258: 
1.655     raeburn  16259: parents (array containing containers directories for current category, 
                   16260:          back to top level). 
                   16261: 
                   16262: Returns: nothing
                   16263: 
                   16264: Side effects: populates trails and allitems hash references
                   16265: 
                   16266: =cut
                   16267: 
                   16268: sub recurse_categories {
1.1321    raeburn  16269:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655     raeburn  16270:     my $shallower = $depth - 1;
                   16271:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   16272:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   16273:             my $name = $cats->[$depth]{$category}[$k];
                   16274:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321    raeburn  16275:             my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  16276:             if ($allitems->{$item} eq '') {
                   16277:                 push(@{$trails},$trailstr);
                   16278:                 $allitems->{$item} = scalar(@{$trails})-1;
                   16279:             }
                   16280:             my $deeper = $depth+1;
                   16281:             push(@{$parents},$category);
1.665     raeburn  16282:             if (ref($subcats) eq 'HASH') {
                   16283:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   16284:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   16285:                     my $higher;
                   16286:                     if ($j > 0) {
                   16287:                         $higher = &escape($parents->[$j]).':'.
                   16288:                                   &escape($parents->[$j-1]).':'.$j;
                   16289:                     } else {
                   16290:                         $higher = &escape($parents->[$j]).'::'.$j;
                   16291:                     }
                   16292:                     push(@{$subcats->{$higher}},$subcat);
                   16293:                 }
                   16294:             }
                   16295:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321    raeburn  16296:                                 $subcats,$maxd);
1.655     raeburn  16297:             pop(@{$parents});
                   16298:         }
                   16299:     } else {
                   16300:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321    raeburn  16301:         my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  16302:         if ($allitems->{$item} eq '') {
                   16303:             push(@{$trails},$trailstr);
                   16304:             $allitems->{$item} = scalar(@{$trails})-1;
                   16305:         }
1.1321    raeburn  16306:         if (ref($maxd) eq 'HASH') {
                   16307:             if ($depth > $maxd->{$parents->[0]}) {
                   16308:                 $maxd->{$parents->[0]} = $depth;
                   16309:             }
                   16310:         }
1.655     raeburn  16311:     }
                   16312:     return;
                   16313: }
                   16314: 
1.663     raeburn  16315: =pod
                   16316: 
1.1162    raeburn  16317: =item * &assign_categories_table()
1.663     raeburn  16318: 
                   16319: Create a datatable for display of hierarchical categories in a domain,
                   16320: with checkboxes to allow a course to be categorized. 
                   16321: 
                   16322: Inputs:
                   16323: 
                   16324: cathash - reference to hash of categories defined for the domain (from
                   16325:           configuration.db)
                   16326: 
                   16327: currcat - scalar with an & separated list of categories assigned to a course. 
                   16328: 
1.919     raeburn  16329: type    - scalar contains course type (Course or Community).
                   16330: 
1.1260    raeburn  16331: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   16332:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   16333: 
1.663     raeburn  16334: Returns: $output (markup to be displayed) 
                   16335: 
                   16336: =cut
                   16337: 
                   16338: sub assign_categories_table {
1.1259    raeburn  16339:     my ($cathash,$currcat,$type,$disabled) = @_;
1.663     raeburn  16340:     my $output;
                   16341:     if (ref($cathash) eq 'HASH') {
1.1321    raeburn  16342:         my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
                   16343:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663     raeburn  16344:         $maxdepth = scalar(@cats);
                   16345:         if (@cats > 0) {
                   16346:             my $itemcount = 0;
                   16347:             if (ref($cats[0]) eq 'ARRAY') {
                   16348:                 my @currcategories;
                   16349:                 if ($currcat ne '') {
                   16350:                     @currcategories = split('&',$currcat);
                   16351:                 }
1.919     raeburn  16352:                 my $table;
1.663     raeburn  16353:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   16354:                     my $parent = $cats[0][$i];
1.919     raeburn  16355:                     next if ($parent eq 'instcode');
                   16356:                     if ($type eq 'Community') {
                   16357:                         next unless ($parent eq 'communities');
1.1239    raeburn  16358:                     } elsif ($type eq 'Placement') {
                   16359:                         next unless ($parent eq 'placement');
1.919     raeburn  16360:                     } else {
1.1239    raeburn  16361:                         next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919     raeburn  16362:                     }
1.663     raeburn  16363:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   16364:                     my $item = &escape($parent).'::0';
                   16365:                     my $checked = '';
                   16366:                     if (@currcategories > 0) {
                   16367:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   16368:                             $checked = ' checked="checked"';
1.663     raeburn  16369:                         }
                   16370:                     }
1.919     raeburn  16371:                     my $parent_title = $parent;
                   16372:                     if ($parent eq 'communities') {
                   16373:                         $parent_title = &mt('Communities');
1.1239    raeburn  16374:                     } elsif ($parent eq 'placement') {
                   16375:                         $parent_title = &mt('Placement Tests');
1.919     raeburn  16376:                     }
                   16377:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   16378:                               '<input type="checkbox" name="usecategory" value="'.
1.1259    raeburn  16379:                               $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919     raeburn  16380:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  16381:                     my $depth = 1;
                   16382:                     push(@path,$parent);
1.1259    raeburn  16383:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663     raeburn  16384:                     pop(@path);
1.919     raeburn  16385:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  16386:                     $itemcount ++;
                   16387:                 }
1.919     raeburn  16388:                 if ($itemcount) {
                   16389:                     $output = &Apache::loncommon::start_data_table().
                   16390:                               $table.
                   16391:                               &Apache::loncommon::end_data_table();
                   16392:                 }
1.663     raeburn  16393:             }
                   16394:         }
                   16395:     }
                   16396:     return $output;
                   16397: }
                   16398: 
                   16399: =pod
                   16400: 
1.1162    raeburn  16401: =item * &assign_category_rows()
1.663     raeburn  16402: 
                   16403: Create a datatable row for display of nested categories in a domain,
                   16404: with checkboxes to allow a course to be categorized,called recursively.
                   16405: 
                   16406: Inputs:
                   16407: 
                   16408: itemcount - track row number for alternating colors
                   16409: 
                   16410: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   16411:       categories and subcategories.
                   16412: 
                   16413: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   16414: 
                   16415: parent - parent of current category item
                   16416: 
                   16417: path - Array containing all categories back up through the hierarchy from the
                   16418:        current category to the top level.
                   16419: 
                   16420: currcategories - reference to array of current categories assigned to the course
                   16421: 
1.1260    raeburn  16422: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   16423:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   16424: 
1.663     raeburn  16425: Returns: $output (markup to be displayed).
                   16426: 
                   16427: =cut
                   16428: 
                   16429: sub assign_category_rows {
1.1259    raeburn  16430:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663     raeburn  16431:     my ($text,$name,$item,$chgstr);
                   16432:     if (ref($cats) eq 'ARRAY') {
                   16433:         my $maxdepth = scalar(@{$cats});
                   16434:         if (ref($cats->[$depth]) eq 'HASH') {
                   16435:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   16436:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   16437:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  16438:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  16439:                 for (my $j=0; $j<$numchildren; $j++) {
                   16440:                     $name = $cats->[$depth]{$parent}[$j];
                   16441:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   16442:                     my $deeper = $depth+1;
                   16443:                     my $checked = '';
                   16444:                     if (ref($currcategories) eq 'ARRAY') {
                   16445:                         if (@{$currcategories} > 0) {
                   16446:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   16447:                                 $checked = ' checked="checked"';
1.663     raeburn  16448:                             }
                   16449:                         }
                   16450:                     }
1.664     raeburn  16451:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   16452:                              '<input type="checkbox" name="usecategory" value="'.
1.1259    raeburn  16453:                              $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675     raeburn  16454:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   16455:                              '</td><td>';
1.663     raeburn  16456:                     if (ref($path) eq 'ARRAY') {
                   16457:                         push(@{$path},$name);
1.1259    raeburn  16458:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663     raeburn  16459:                         pop(@{$path});
                   16460:                     }
                   16461:                     $text .= '</td></tr>';
                   16462:                 }
                   16463:                 $text .= '</table></td>';
                   16464:             }
                   16465:         }
                   16466:     }
                   16467:     return $text;
                   16468: }
                   16469: 
1.1181    raeburn  16470: =pod
                   16471: 
                   16472: =back
                   16473: 
                   16474: =cut
                   16475: 
1.655     raeburn  16476: ############################################################
                   16477: ############################################################
                   16478: 
                   16479: 
1.443     albertel 16480: sub commit_customrole {
1.664     raeburn  16481:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.1399    raeburn  16482:     my $result = &Apache::lonnet::assigncustomrole(
                   16483:                      $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context);
1.630     raeburn  16484:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 16485:                          ($start?', '.&mt('starting').' '.localtime($start):'').
1.1399    raeburn  16486:                          ($end?', ending '.localtime($end):'').': <b>'.$result.'</b><br />';
                   16487:     if (wantarray) {
                   16488:         return ($output,$result);
                   16489:     } else {
                   16490:         return $output;
                   16491:     }
1.443     albertel 16492: }
                   16493: 
                   16494: sub commit_standardrole {
1.1116    raeburn  16495:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.1399    raeburn  16496:     my ($output,$logmsg,$linefeed,$result);
1.541     raeburn  16497:     if ($context eq 'auto') {
                   16498:         $linefeed = "\n";
                   16499:     } else {
                   16500:         $linefeed = "<br />\n";
                   16501:     }  
1.443     albertel 16502:     if ($three eq 'st') {
1.1399    raeburn  16503:         $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   16504:                                       $one,$two,$sec,$context,$credits);
1.541     raeburn  16505:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  16506:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   16507:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 16508:         } else {
1.541     raeburn  16509:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 16510:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  16511:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   16512:             if ($context eq 'auto') {
                   16513:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   16514:             } else {
                   16515:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   16516:                &mt('Add to classlist').': <b>ok</b>';
                   16517:             }
                   16518:             $output .= $linefeed;
1.443     albertel 16519:         }
                   16520:     } else {
                   16521:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   16522:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  16523:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.1399    raeburn  16524:         $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  16525:         if ($context eq 'auto') {
                   16526:             $output .= $result.$linefeed;
                   16527:         } else {
                   16528:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   16529:         }
1.443     albertel 16530:     }
1.1399    raeburn  16531:     if (wantarray) {
                   16532:         return ($output,$result);
                   16533:     } else {
                   16534:         return $output;
                   16535:     }
1.443     albertel 16536: }
                   16537: 
                   16538: sub commit_studentrole {
1.1116    raeburn  16539:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   16540:         $credits) = @_;
1.626     raeburn  16541:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  16542:     if ($context eq 'auto') {
                   16543:         $linefeed = "\n";
                   16544:     } else {
                   16545:         $linefeed = '<br />'."\n";
                   16546:     }
1.443     albertel 16547:     if (defined($one) && defined($two)) {
                   16548:         my $cid=$one.'_'.$two;
                   16549:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   16550:         my $secchange = 0;
                   16551:         my $expire_role_result;
                   16552:         my $modify_section_result;
1.628     raeburn  16553:         if ($oldsec ne '-1') { 
                   16554:             if ($oldsec ne $sec) {
1.443     albertel 16555:                 $secchange = 1;
1.628     raeburn  16556:                 my $now = time;
1.443     albertel 16557:                 my $uurl='/'.$cid;
                   16558:                 $uurl=~s/\_/\//g;
                   16559:                 if ($oldsec) {
                   16560:                     $uurl.='/'.$oldsec;
                   16561:                 }
1.626     raeburn  16562:                 $oldsecurl = $uurl;
1.628     raeburn  16563:                 $expire_role_result = 
1.1398    raeburn  16564:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','','',$context);
1.628     raeburn  16565:                 if ($env{'request.course.sec'} ne '') { 
                   16566:                     if ($expire_role_result eq 'refused') {
                   16567:                         my @roles = ('st');
                   16568:                         my @statuses = ('previous');
                   16569:                         my @roledoms = ($one);
                   16570:                         my $withsec = 1;
                   16571:                         my %roleshash = 
                   16572:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   16573:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   16574:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   16575:                             my ($oldstart,$oldend) = 
                   16576:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   16577:                             if ($oldend > 0 && $oldend <= $now) {
                   16578:                                 $expire_role_result = 'ok';
                   16579:                             }
                   16580:                         }
                   16581:                     }
                   16582:                 }
1.443     albertel 16583:                 $result = $expire_role_result;
                   16584:             }
                   16585:         }
                   16586:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  16587:             $modify_section_result = 
                   16588:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   16589:                                                            undef,undef,undef,$sec,
                   16590:                                                            $end,$start,'','',$cid,
                   16591:                                                            '',$context,$credits);
1.443     albertel 16592:             if ($modify_section_result =~ /^ok/) {
                   16593:                 if ($secchange == 1) {
1.628     raeburn  16594:                     if ($sec eq '') {
                   16595:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   16596:                     } else {
                   16597:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   16598:                     }
1.443     albertel 16599:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  16600:                     if ($sec eq '') {
                   16601:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   16602:                     } else {
                   16603:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   16604:                     }
1.443     albertel 16605:                 } else {
1.628     raeburn  16606:                     if ($sec eq '') {
                   16607:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   16608:                     } else {
                   16609:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   16610:                     }
1.443     albertel 16611:                 }
                   16612:             } else {
1.1115    raeburn  16613:                 if ($secchange) { 
1.628     raeburn  16614:                     $$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;
                   16615:                 } else {
                   16616:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   16617:                 }
1.443     albertel 16618:             }
                   16619:             $result = $modify_section_result;
                   16620:         } elsif ($secchange == 1) {
1.628     raeburn  16621:             if ($oldsec eq '') {
1.1103    raeburn  16622:                 $$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  16623:             } else {
                   16624:                 $$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;
                   16625:             }
1.626     raeburn  16626:             if ($expire_role_result eq 'refused') {
                   16627:                 my $newsecurl = '/'.$cid;
                   16628:                 $newsecurl =~ s/\_/\//g;
                   16629:                 if ($sec ne '') {
                   16630:                     $newsecurl.='/'.$sec;
                   16631:                 }
                   16632:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   16633:                     if ($sec eq '') {
                   16634:                         $$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;
                   16635:                     } else {
                   16636:                         $$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;
                   16637:                     }
                   16638:                 }
                   16639:             }
1.443     albertel 16640:         }
                   16641:     } else {
1.626     raeburn  16642:         $$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 16643:         $result = "error: incomplete course id\n";
                   16644:     }
                   16645:     return $result;
                   16646: }
                   16647: 
1.1108    raeburn  16648: sub show_role_extent {
                   16649:     my ($scope,$context,$role) = @_;
                   16650:     $scope =~ s{^/}{};
                   16651:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   16652:     push(@courseroles,'co');
                   16653:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   16654:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   16655:         $scope =~ s{/}{_};
                   16656:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   16657:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   16658:         my ($audom,$auname) = split(/\//,$scope);
                   16659:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   16660:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   16661:     } else {
                   16662:         $scope =~ s{/$}{};
                   16663:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   16664:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   16665:     }
                   16666: }
                   16667: 
1.443     albertel 16668: ############################################################
                   16669: ############################################################
                   16670: 
1.566     albertel 16671: sub check_clone {
1.578     raeburn  16672:     my ($args,$linefeed) = @_;
1.566     albertel 16673:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   16674:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   16675:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344    raeburn  16676:     my $clonetitle;
                   16677:     my @clonemsg;
1.566     albertel 16678:     my $can_clone = 0;
1.944     raeburn  16679:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  16680:     if ($lctype ne 'community') {
                   16681:         $lctype = 'course';
                   16682:     }
1.566     albertel 16683:     if ($clonehome eq 'no_host') {
1.944     raeburn  16684:         if ($args->{'crstype'} eq 'Community') {
1.1344    raeburn  16685:             push(@clonemsg,({
                   16686:                               mt => 'No new community created.',
                   16687:                               args => [],
                   16688:                             },
                   16689:                             {
                   16690:                               mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
                   16691:                               args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
                   16692:                             }));
1.908     raeburn  16693:         } else {
1.1344    raeburn  16694:             push(@clonemsg,({
                   16695:                               mt => 'No new course created.',
                   16696:                               args => [],
                   16697:                             },
                   16698:                             {
                   16699:                               mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
                   16700:                               args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                   16701:                             }));
                   16702:         }
1.566     albertel 16703:     } else {
                   16704: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344    raeburn  16705:         $clonetitle = $clonedesc{'description'};
1.944     raeburn  16706:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  16707:             if ($clonedesc{'type'} ne 'Community') {
1.1344    raeburn  16708:                 push(@clonemsg,({
                   16709:                                   mt => 'No new community created.',
                   16710:                                   args => [],
                   16711:                                 },
                   16712:                                 {
                   16713:                                   mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
                   16714:                                   args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                   16715:                                 }));
                   16716:                 return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908     raeburn  16717:             }
                   16718:         }
1.1262    raeburn  16719: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882     raeburn  16720:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 16721: 	    $can_clone = 1;
                   16722: 	} else {
1.1221    raeburn  16723: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 16724: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1221    raeburn  16725:             if ($clonehash{'cloners'} eq '') {
                   16726:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   16727:                 if ($domdefs{'canclone'}) {
                   16728:                     unless ($domdefs{'canclone'} eq 'none') {
                   16729:                         if ($domdefs{'canclone'} eq 'domain') {
                   16730:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   16731:                                 $can_clone = 1;
                   16732:                             }
                   16733:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   16734:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   16735:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   16736:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   16737:                                 $can_clone = 1;
                   16738:                             }
                   16739:                         }
                   16740:                     }
                   16741:                 }
1.578     raeburn  16742:             } else {
1.1221    raeburn  16743: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   16744:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  16745:                     $can_clone = 1;
1.1221    raeburn  16746:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  16747:                     $can_clone = 1;
1.1225    raeburn  16748:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   16749:                     $can_clone = 1;
1.1221    raeburn  16750:                 }
                   16751:                 unless ($can_clone) {
1.1225    raeburn  16752:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   16753:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1221    raeburn  16754:                         my (%gotdomdefaults,%gotcodedefaults);
                   16755:                         foreach my $cloner (@cloners) {
                   16756:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   16757:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   16758:                                 my (%codedefaults,@code_order);
                   16759:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   16760:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   16761:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   16762:                                     }
                   16763:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   16764:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   16765:                                     }
                   16766:                                 } else {
                   16767:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   16768:                                                                             \%codedefaults,
                   16769:                                                                             \@code_order);
                   16770:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   16771:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   16772:                                 }
                   16773:                                 if (@code_order > 0) {
                   16774:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   16775:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   16776:                                                                                 $args->{'crscode'})) {
                   16777:                                         $can_clone = 1;
                   16778:                                         last;
                   16779:                                     }
                   16780:                                 }
                   16781:                             }
                   16782:                         }
                   16783:                     }
1.1225    raeburn  16784:                 }
                   16785:             }
                   16786:             unless ($can_clone) {
                   16787:                 my $ccrole = 'cc';
                   16788:                 if ($args->{'crstype'} eq 'Community') {
                   16789:                     $ccrole = 'co';
                   16790:                 }
                   16791: 	        my %roleshash =
                   16792: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   16793: 					          $args->{'ccdomain'},
                   16794:                                                   'userroles',['active'],[$ccrole],
                   16795: 					          [$args->{'clonedomain'}]);
                   16796: 	        if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   16797:                     $can_clone = 1;
                   16798:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   16799:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   16800:                     $can_clone = 1;
1.1221    raeburn  16801:                 }
                   16802:             }
                   16803:             unless ($can_clone) {
                   16804:                 if ($args->{'crstype'} eq 'Community') {
1.1344    raeburn  16805:                     push(@clonemsg,({
                   16806:                                       mt => 'No new community created.',
                   16807:                                       args => [],
                   16808:                                     },
                   16809:                                     {
                   16810:                                       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]).',
                   16811:                                       args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                   16812:                                     }));
1.942     raeburn  16813:                 } else {
1.1344    raeburn  16814:                     push(@clonemsg,({
                   16815:                                       mt => 'No new course created.',
                   16816:                                       args => [],
                   16817:                                     },
                   16818:                                     {
                   16819:                                       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]).',
                   16820:                                       args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                   16821:                                     }));
1.1221    raeburn  16822:                 }
1.566     albertel 16823: 	    }
1.578     raeburn  16824:         }
1.566     albertel 16825:     }
1.1344    raeburn  16826:     return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566     albertel 16827: }
                   16828: 
1.444     albertel 16829: sub construct_course {
1.1262    raeburn  16830:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344    raeburn  16831:         $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
                   16832:     my ($outcome,$msgref,$clonemsgref);
1.541     raeburn  16833:     my $linefeed =  '<br />'."\n";
                   16834:     if ($context eq 'auto') {
                   16835:         $linefeed = "\n";
                   16836:     }
1.566     albertel 16837: 
                   16838: #
                   16839: # Are we cloning?
                   16840: #
1.1344    raeburn  16841:     my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566     albertel 16842:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344    raeburn  16843: 	($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566     albertel 16844:         if (!$can_clone) {
1.1344    raeburn  16845: 	    return (0,$outcome,$clonemsgref);
1.566     albertel 16846: 	}
                   16847:     }
                   16848: 
1.444     albertel 16849: #
                   16850: # Open course
                   16851: #
1.1239    raeburn  16852:     my $showncrstype;
                   16853:     if ($args->{'crstype'} eq 'Placement') {
                   16854:         $showncrstype = 'placement test'; 
                   16855:     } else {  
                   16856:         $showncrstype = lc($args->{'crstype'});
                   16857:     }
1.444     albertel 16858:     my %cenv=();
                   16859:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   16860:                                              $args->{'cdescr'},
                   16861:                                              $args->{'curl'},
                   16862:                                              $args->{'course_home'},
                   16863:                                              $args->{'nonstandard'},
                   16864:                                              $args->{'crscode'},
                   16865:                                              $args->{'ccuname'}.':'.
                   16866:                                              $args->{'ccdomain'},
1.882     raeburn  16867:                                              $args->{'crstype'},
1.1344    raeburn  16868:                                              $cnum,$context,$category,
                   16869:                                              $callercontext);
1.444     albertel 16870: 
                   16871:     # Note: The testing routines depend on this being output; see 
                   16872:     # Utils::Course. This needs to at least be output as a comment
                   16873:     # if anyone ever decides to not show this, and Utils::Course::new
                   16874:     # will need to be suitably modified.
1.1344    raeburn  16875:     if (($callercontext eq 'auto') && ($user_lh ne '')) {
                   16876:         $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
                   16877:     } else {
                   16878:         $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
                   16879:     }
1.943     raeburn  16880:     if ($$courseid =~ /^error:/) {
1.1344    raeburn  16881:         return (0,$outcome,$clonemsgref);
1.943     raeburn  16882:     }
                   16883: 
1.444     albertel 16884: #
                   16885: # Check if created correctly
                   16886: #
1.479     albertel 16887:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 16888:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  16889:     if ($crsuhome eq 'no_host') {
1.1344    raeburn  16890:         if (($callercontext eq 'auto') && ($user_lh ne '')) {
                   16891:             $outcome .= &mt_user($user_lh,
                   16892:                             'Course creation failed, unrecognized course home server.');
                   16893:         } else {
                   16894:             $outcome .= &mt('Course creation failed, unrecognized course home server.');
                   16895:         }
                   16896:         $outcome .= $linefeed;
                   16897:         return (0,$outcome,$clonemsgref);
1.943     raeburn  16898:     }
1.541     raeburn  16899:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 16900: 
1.444     albertel 16901: #
1.566     albertel 16902: # Do the cloning
                   16903: #   
1.1344    raeburn  16904:     my @clonemsg;
1.566     albertel 16905:     if ($can_clone && $cloneid) {
1.1344    raeburn  16906:         push(@clonemsg,
                   16907:                       {
                   16908:                           mt => 'Created [_1] by cloning from [_2]',
                   16909:                           args => [$showncrstype,$clonetitle],
                   16910:                       });
1.566     albertel 16911: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 16912: # Copy all files
1.1344    raeburn  16913:         my @info =
                   16914: 	    &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
                   16915: 	                                             $args->{'dateshift'},$args->{'crscode'},
                   16916:                                                      $args->{'ccuname'}.':'.$args->{'ccdomain'},
                   16917:                                                      $args->{'tinyurls'});
                   16918:         if (@info) {
                   16919:             push(@clonemsg,@info);
                   16920:         }
1.444     albertel 16921: # Restore URL
1.566     albertel 16922: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 16923: # Restore title
1.566     albertel 16924: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  16925: # Restore creation date, creator and creation context.
                   16926:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   16927:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   16928:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 16929: # Mark as cloned
1.566     albertel 16930: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      16931: # Need to clone grading mode
                   16932:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   16933:         $cenv{'grading'}=$newenv{'grading'};
                   16934: # Do not clone these environment entries
                   16935:         &Apache::lonnet::del('environment',
                   16936:                   ['default_enrollment_start_date',
                   16937:                    'default_enrollment_end_date',
                   16938:                    'question.email',
                   16939:                    'policy.email',
                   16940:                    'comment.email',
                   16941:                    'pch.users.denied',
1.725     raeburn  16942:                    'plc.users.denied',
                   16943:                    'hidefromcat',
1.1121    raeburn  16944:                    'checkforpriv',
1.1355    raeburn  16945:                    'categories'],
1.638     www      16946:                    $$crsudom,$$crsunum);
1.1170    raeburn  16947:         if ($args->{'textbook'}) {
                   16948:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   16949:         }
1.444     albertel 16950:     }
1.566     albertel 16951: 
1.444     albertel 16952: #
                   16953: # Set environment (will override cloned, if existing)
                   16954: #
                   16955:     my @sections = ();
                   16956:     my @xlists = ();
                   16957:     if ($args->{'crstype'}) {
                   16958:         $cenv{'type'}=$args->{'crstype'};
                   16959:     }
1.1371    raeburn  16960:     if ($args->{'lti'}) {
                   16961:         $cenv{'internal.lti'}=$args->{'lti'};
                   16962:     }
1.444     albertel 16963:     if ($args->{'crsid'}) {
                   16964:         $cenv{'courseid'}=$args->{'crsid'};
                   16965:     }
                   16966:     if ($args->{'crscode'}) {
                   16967:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   16968:     }
                   16969:     if ($args->{'crsquota'} ne '') {
                   16970:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   16971:     } else {
                   16972:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   16973:     }
                   16974:     if ($args->{'ccuname'}) {
                   16975:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   16976:                                         ':'.$args->{'ccdomain'};
                   16977:     } else {
                   16978:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   16979:     }
1.1116    raeburn  16980:     if ($args->{'defaultcredits'}) {
                   16981:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   16982:     }
1.444     albertel 16983:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   16984:     if ($args->{'crssections'}) {
                   16985:         $cenv{'internal.sectionnums'} = '';
                   16986:         if ($args->{'crssections'} =~ m/,/) {
                   16987:             @sections = split/,/,$args->{'crssections'};
                   16988:         } else {
                   16989:             $sections[0] = $args->{'crssections'};
                   16990:         }
                   16991:         if (@sections > 0) {
                   16992:             foreach my $item (@sections) {
                   16993:                 my ($sec,$gp) = split/:/,$item;
                   16994:                 my $class = $args->{'crscode'}.$sec;
                   16995:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   16996:                 $cenv{'internal.sectionnums'} .= $item.',';
                   16997:                 unless ($addcheck eq 'ok') {
1.1263    raeburn  16998:                     push(@badclasses,$class);
1.444     albertel 16999:                 }
                   17000:             }
                   17001:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   17002:         }
                   17003:     }
                   17004: # do not hide course coordinator from staff listing, 
                   17005: # even if privileged
                   17006:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  17007: # add course coordinator's domain to domains to check for privileged users
                   17008: # if different to course domain
                   17009:     if ($$crsudom ne $args->{'ccdomain'}) {
                   17010:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   17011:     }
1.444     albertel 17012: # add crosslistings
                   17013:     if ($args->{'crsxlist'}) {
                   17014:         $cenv{'internal.crosslistings'}='';
                   17015:         if ($args->{'crsxlist'} =~ m/,/) {
                   17016:             @xlists = split/,/,$args->{'crsxlist'};
                   17017:         } else {
                   17018:             $xlists[0] = $args->{'crsxlist'};
                   17019:         }
                   17020:         if (@xlists > 0) {
                   17021:             foreach my $item (@xlists) {
                   17022:                 my ($xl,$gp) = split/:/,$item;
                   17023:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   17024:                 $cenv{'internal.crosslistings'} .= $item.',';
                   17025:                 unless ($addcheck eq 'ok') {
1.1263    raeburn  17026:                     push(@badclasses,$xl);
1.444     albertel 17027:                 }
                   17028:             }
                   17029:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   17030:         }
                   17031:     }
                   17032:     if ($args->{'autoadds'}) {
                   17033:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   17034:     }
                   17035:     if ($args->{'autodrops'}) {
                   17036:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   17037:     }
                   17038: # check for notification of enrollment changes
                   17039:     my @notified = ();
                   17040:     if ($args->{'notify_owner'}) {
                   17041:         if ($args->{'ccuname'} ne '') {
                   17042:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   17043:         }
                   17044:     }
                   17045:     if ($args->{'notify_dc'}) {
                   17046:         if ($uname ne '') { 
1.630     raeburn  17047:             push(@notified,$uname.':'.$udom);
1.444     albertel 17048:         }
                   17049:     }
                   17050:     if (@notified > 0) {
                   17051:         my $notifylist;
                   17052:         if (@notified > 1) {
                   17053:             $notifylist = join(',',@notified);
                   17054:         } else {
                   17055:             $notifylist = $notified[0];
                   17056:         }
                   17057:         $cenv{'internal.notifylist'} = $notifylist;
                   17058:     }
                   17059:     if (@badclasses > 0) {
                   17060:         my %lt=&Apache::lonlocal::texthash(
1.1264    raeburn  17061:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                   17062:                 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                   17063:                 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444     albertel 17064:         );
1.1264    raeburn  17065:         my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                   17066:                            &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  17067:         if ($context eq 'auto') {
                   17068:             $outcome .= $badclass_msg.$linefeed;
1.1261    raeburn  17069:         } else {
1.566     albertel 17070:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261    raeburn  17071:         }
                   17072:         foreach my $item (@badclasses) {
1.541     raeburn  17073:             if ($context eq 'auto') {
1.1261    raeburn  17074:                 $outcome .= " - $item\n";
1.541     raeburn  17075:             } else {
1.1261    raeburn  17076:                 $outcome .= "<li>$item</li>\n";
1.541     raeburn  17077:             }
1.1261    raeburn  17078:         }
                   17079:         if ($context eq 'auto') {
                   17080:             $outcome .= $linefeed;
                   17081:         } else {
                   17082:             $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  17083:         } 
1.444     albertel 17084:     }
                   17085:     if ($args->{'no_end_date'}) {
                   17086:         $args->{'endaccess'} = 0;
                   17087:     }
                   17088:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   17089:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   17090:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   17091:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   17092:     if ($args->{'showphotos'}) {
                   17093:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   17094:     }
                   17095:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   17096:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   17097:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   17098:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  17099:             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'); 
                   17100:             if ($context eq 'auto') {
                   17101:                 $outcome .= $krb_msg;
                   17102:             } else {
1.566     albertel 17103:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  17104:             }
                   17105:             $outcome .= $linefeed;
1.444     albertel 17106:         }
                   17107:     }
                   17108:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   17109:        if ($args->{'setpolicy'}) {
                   17110:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   17111:        }
                   17112:        if ($args->{'setcontent'}) {
                   17113:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   17114:        }
1.1251    raeburn  17115:        if ($args->{'setcomment'}) {
                   17116:            $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   17117:        }
1.444     albertel 17118:     }
                   17119:     if ($args->{'reshome'}) {
                   17120: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   17121: 	$cenv{'reshome'}=~s/\/+$/\//;
                   17122:     }
                   17123: #
                   17124: # course has keyed access
                   17125: #
                   17126:     if ($args->{'setkeys'}) {
                   17127:        $cenv{'keyaccess'}='yes';
                   17128:     }
                   17129: # if specified, key authority is not course, but user
                   17130: # only active if keyaccess is yes
                   17131:     if ($args->{'keyauth'}) {
1.487     albertel 17132: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   17133: 	$user = &LONCAPA::clean_username($user);
                   17134: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     17135: 	if ($user ne '' && $domain ne '') {
1.487     albertel 17136: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 17137: 	}
                   17138:     }
                   17139: 
1.1166    raeburn  17140: #
1.1167    raeburn  17141: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  17142: #
                   17143:     if ($args->{'uniquecode'}) {
                   17144:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   17145:         if ($code) {
                   17146:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  17147:             my %crsinfo =
                   17148:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   17149:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   17150:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   17151:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   17152:             } 
1.1166    raeburn  17153:             if (ref($coderef)) {
                   17154:                 $$coderef = $code;
                   17155:             }
                   17156:         }
                   17157:     }
                   17158: 
1.444     albertel 17159:     if ($args->{'disresdis'}) {
                   17160:         $cenv{'pch.roles.denied'}='st';
                   17161:     }
                   17162:     if ($args->{'disablechat'}) {
                   17163:         $cenv{'plc.roles.denied'}='st';
                   17164:     }
                   17165: 
                   17166:     # Record we've not yet viewed the Course Initialization Helper for this 
                   17167:     # course
                   17168:     $cenv{'course.helper.not.run'} = 1;
                   17169:     #
                   17170:     # Use new Randomseed
                   17171:     #
                   17172:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   17173:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   17174:     #
                   17175:     # The encryption code and receipt prefix for this course
                   17176:     #
                   17177:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   17178:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   17179:     #
                   17180:     # By default, use standard grading
                   17181:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   17182: 
1.541     raeburn  17183:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   17184:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 17185: #
                   17186: # Open all assignments
                   17187: #
                   17188:     if ($args->{'openall'}) {
1.1341    raeburn  17189:        my $opendate = time;
                   17190:        if ($args->{'openallfrom'} =~ /^\d+$/) {
                   17191:            $opendate = $args->{'openallfrom'};
                   17192:        }
1.444     albertel 17193:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341    raeburn  17194:        my %storecontent = ($storeunder         => $opendate,
1.444     albertel 17195:                            $storeunder.'.type' => 'date_start');
1.1341    raeburn  17196:        $outcome .= &mt('All assignments open starting [_1]',
                   17197:                        &Apache::lonlocal::locallocaltime($opendate)).': '.
                   17198:                    &Apache::lonnet::cput
                   17199:                        ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 17200:    }
                   17201: #
                   17202: # Set first page
                   17203: #
                   17204:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   17205: 	    || ($cloneid)) {
                   17206: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 17207: 
                   17208: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   17209:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   17210: 
1.444     albertel 17211:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   17212:         my $title; my $url;
                   17213:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   17214: 	    $title=&mt('Syllabus');
1.444     albertel 17215:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   17216:         } else {
1.963     raeburn  17217:             $title=&mt('Table of Contents');
1.444     albertel 17218:             $url='/adm/navmaps';
                   17219:         }
1.445     albertel 17220: 
                   17221:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   17222: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   17223: 
                   17224: 	if ($errtext) { $fatal=2; }
1.541     raeburn  17225:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 17226:     }
1.566     albertel 17227: 
1.1237    raeburn  17228: # 
                   17229: # Set params for Placement Tests
                   17230: #
1.1239    raeburn  17231:     if ($args->{'crstype'} eq 'Placement') {
                   17232:        my %storecontent; 
                   17233:        my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
                   17234:        my %defaults = (
                   17235:                         buttonshide   => { value => 'yes',
                   17236:                                            type => 'string_yesno',},
                   17237:                         type          => { value => 'randomizetry',
                   17238:                                            type  => 'string_questiontype',},
                   17239:                         maxtries      => { value => 1,
                   17240:                                            type => 'int_pos',},
                   17241:                         problemstatus => { value => 'no',
                   17242:                                            type  => 'string_problemstatus',},
                   17243:                       );
                   17244:        foreach my $key (keys(%defaults)) {
                   17245:            $storecontent{$prefix.$key} = $defaults{$key}{'value'};
                   17246:            $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
                   17247:        }
1.1237    raeburn  17248:        &Apache::lonnet::cput
                   17249:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
                   17250:     }
                   17251: 
1.1344    raeburn  17252:     return (1,$outcome,\@clonemsg);
1.444     albertel 17253: }
                   17254: 
1.1166    raeburn  17255: sub make_unique_code {
                   17256:     my ($cdom,$cnum) = @_;
                   17257:     # get lock on uniquecodes db
                   17258:     my $lockhash = {
                   17259:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   17260:                                                   ':'.$env{'user.domain'},
                   17261:                    };
                   17262:     my $tries = 0;
                   17263:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   17264:     my ($code,$error);
                   17265:   
                   17266:     while (($gotlock ne 'ok') && ($tries<3)) {
                   17267:         $tries ++;
                   17268:         sleep 1;
                   17269:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   17270:     }
                   17271:     if ($gotlock eq 'ok') {
                   17272:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   17273:         my $gotcode;
                   17274:         my $attempts = 0;
                   17275:         while ((!$gotcode) && ($attempts < 100)) {
                   17276:             $code = &generate_code();
                   17277:             if (!exists($currcodes{$code})) {
                   17278:                 $gotcode = 1;
                   17279:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   17280:                     $error = 'nostore';
                   17281:                 }
                   17282:             }
                   17283:             $attempts ++;
                   17284:         }
                   17285:         my @del_lock = ($cnum."\0".'uniquecodes');
                   17286:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   17287:     } else {
                   17288:         $error = 'nolock';
                   17289:     }
                   17290:     return ($code,$error);
                   17291: }
                   17292: 
                   17293: sub generate_code {
                   17294:     my $code;
                   17295:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   17296:     for (my $i=0; $i<6; $i++) {
                   17297:         my $lettnum = int (rand 2);
                   17298:         my $item = '';
                   17299:         if ($lettnum) {
                   17300:             $item = $letts[int( rand(18) )];
                   17301:         } else {
                   17302:             $item = 1+int( rand(8) );
                   17303:         }
                   17304:         $code .= $item;
                   17305:     }
                   17306:     return $code;
                   17307: }
                   17308: 
1.444     albertel 17309: ############################################################
                   17310: ############################################################
                   17311: 
1.1237    raeburn  17312: # Community, Course and Placement Test
1.378     raeburn  17313: sub course_type {
                   17314:     my ($cid) = @_;
                   17315:     if (!defined($cid)) {
                   17316:         $cid = $env{'request.course.id'};
                   17317:     }
1.404     albertel 17318:     if (defined($env{'course.'.$cid.'.type'})) {
                   17319:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  17320:     } else {
                   17321:         return 'Course';
1.377     raeburn  17322:     }
                   17323: }
1.156     albertel 17324: 
1.406     raeburn  17325: sub group_term {
                   17326:     my $crstype = &course_type();
                   17327:     my %names = (
                   17328:                   'Course' => 'group',
1.865     raeburn  17329:                   'Community' => 'group',
1.1237    raeburn  17330:                   'Placement' => 'group',
1.406     raeburn  17331:                 );
                   17332:     return $names{$crstype};
                   17333: }
                   17334: 
1.902     raeburn  17335: sub course_types {
1.1310    raeburn  17336:     my @types = ('official','unofficial','community','textbook','placement','lti');
1.902     raeburn  17337:     my %typename = (
                   17338:                          official   => 'Official course',
                   17339:                          unofficial => 'Unofficial course',
                   17340:                          community  => 'Community',
1.1165    raeburn  17341:                          textbook   => 'Textbook course',
1.1237    raeburn  17342:                          placement  => 'Placement test',
1.1310    raeburn  17343:                          lti        => 'LTI provider',
1.902     raeburn  17344:                    );
                   17345:     return (\@types,\%typename);
                   17346: }
                   17347: 
1.156     albertel 17348: sub icon {
                   17349:     my ($file)=@_;
1.505     albertel 17350:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 17351:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 17352:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 17353:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   17354: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   17355: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   17356: 	            $curfext.".gif") {
                   17357: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   17358: 		$curfext.".gif";
                   17359: 	}
                   17360:     }
1.249     albertel 17361:     return &lonhttpdurl($iconname);
1.154     albertel 17362: } 
1.84      albertel 17363: 
1.575     albertel 17364: sub lonhttpdurl {
1.692     www      17365: #
                   17366: # Had been used for "small fry" static images on separate port 8080.
                   17367: # Modify here if lightweight http functionality desired again.
                   17368: # Currently eliminated due to increasing firewall issues.
                   17369: #
1.575     albertel 17370:     my ($url)=@_;
1.692     www      17371:     return $url;
1.215     albertel 17372: }
                   17373: 
1.213     albertel 17374: sub connection_aborted {
                   17375:     my ($r)=@_;
                   17376:     $r->print(" ");$r->rflush();
                   17377:     my $c = $r->connection;
                   17378:     return $c->aborted();
                   17379: }
                   17380: 
1.221     foxr     17381: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     17382: #    strings as 'strings'.
                   17383: sub escape_single {
1.221     foxr     17384:     my ($input) = @_;
1.223     albertel 17385:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     17386:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   17387:     return $input;
                   17388: }
1.223     albertel 17389: 
1.222     foxr     17390: #  Same as escape_single, but escape's "'s  This 
                   17391: #  can be used for  "strings"
                   17392: sub escape_double {
                   17393:     my ($input) = @_;
                   17394:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   17395:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   17396:     return $input;
                   17397: }
1.223     albertel 17398:  
1.222     foxr     17399: #   Escapes the last element of a full URL.
                   17400: sub escape_url {
                   17401:     my ($url)   = @_;
1.238     raeburn  17402:     my @urlslices = split(/\//, $url,-1);
1.369     www      17403:     my $lastitem = &escape(pop(@urlslices));
1.1203    raeburn  17404:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     17405: }
1.462     albertel 17406: 
1.820     raeburn  17407: sub compare_arrays {
                   17408:     my ($arrayref1,$arrayref2) = @_;
                   17409:     my (@difference,%count);
                   17410:     @difference = ();
                   17411:     %count = ();
                   17412:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   17413:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   17414:         foreach my $element (keys(%count)) {
                   17415:             if ($count{$element} == 1) {
                   17416:                 push(@difference,$element);
                   17417:             }
                   17418:         }
                   17419:     }
                   17420:     return @difference;
                   17421: }
                   17422: 
1.1322    raeburn  17423: sub lon_status_items {
                   17424:     my %defaults = (
                   17425:                      E         => 100,
                   17426:                      W         => 4,
                   17427:                      N         => 1,
1.1324    raeburn  17428:                      U         => 5,
1.1322    raeburn  17429:                      threshold => 200,
                   17430:                      sysmail   => 2500,
                   17431:                    );
                   17432:     my %names = (
                   17433:                    E => 'Errors',
                   17434:                    W => 'Warnings',
                   17435:                    N => 'Notices',
1.1324    raeburn  17436:                    U => 'Unsent',
1.1322    raeburn  17437:                 );
                   17438:     return (\%defaults,\%names);
                   17439: }
                   17440: 
1.817     bisitz   17441: # -------------------------------------------------------- Initialize user login
1.462     albertel 17442: sub init_user_environment {
1.463     albertel 17443:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 17444:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   17445: 
                   17446:     my $public=($username eq 'public' && $domain eq 'public');
                   17447: 
1.1062    raeburn  17448:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 17449:     my $now=time;
                   17450: 
                   17451:     if ($public) {
                   17452: 	my $max_public=100;
                   17453: 	my $oldest;
                   17454: 	my $oldest_time=0;
                   17455: 	for(my $next=1;$next<=$max_public;$next++) {
                   17456: 	    if (-e $lonids."/publicuser_$next.id") {
                   17457: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   17458: 		if ($mtime<$oldest_time || !$oldest_time) {
                   17459: 		    $oldest_time=$mtime;
                   17460: 		    $oldest=$next;
                   17461: 		}
                   17462: 	    } else {
                   17463: 		$cookie="publicuser_$next";
                   17464: 		last;
                   17465: 	    }
                   17466: 	}
                   17467: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   17468:     } else {
1.1275    raeburn  17469: 	# See if old ID present, if so, remove if this isn't a robot,
                   17470: 	# killing any existing non-robot sessions
1.463     albertel 17471: 	if (!$args->{'robot'}) {
                   17472: 	    opendir(DIR,$lonids);
                   17473: 	    while ($filename=readdir(DIR)) {
                   17474: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320    raeburn  17475:                     if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
                   17476:                             &GDBM_READER(),0640)) {
1.1295    raeburn  17477:                         my $linkedfile;
1.1320    raeburn  17478:                         if (exists($oldenv{'user.linkedenv'})) {
                   17479:                             $linkedfile = $oldenv{'user.linkedenv'};
1.1295    raeburn  17480:                         }
1.1320    raeburn  17481:                         untie(%oldenv);
                   17482:                         if (unlink("$lonids/$filename")) {
                   17483:                             if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                   17484:                                 if (-l "$lonids/$linkedfile.id") {
                   17485:                                     unlink("$lonids/$linkedfile.id");
                   17486:                                 }
1.1295    raeburn  17487:                             }
                   17488:                         }
                   17489:                     } else {
                   17490:                         unlink($lonids.'/'.$filename);
                   17491:                     }
1.463     albertel 17492: 		}
1.462     albertel 17493: 	    }
1.463     albertel 17494: 	    closedir(DIR);
1.1204    raeburn  17495: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   17496:             my $namespace = 'nohist_courseeditor';
                   17497:             my $lockingkey = 'paste'."\0".'locked_num';
                   17498:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   17499:                                                 $domain,$username);
                   17500:             if (exists($lockhash{$lockingkey})) {
                   17501:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   17502:                 unless ($delresult eq 'ok') {
                   17503:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   17504:                 }
                   17505:             }
1.462     albertel 17506: 	}
                   17507: # Give them a new cookie
1.463     albertel 17508: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      17509: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 17510: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 17511:     
                   17512: # Initialize roles
                   17513: 
1.1062    raeburn  17514: 	($userroles,$firstaccenv,$timerintenv) = 
                   17515:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 17516:     }
                   17517: # ------------------------------------ Check browser type and MathML capability
                   17518: 
1.1194    raeburn  17519:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   17520:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 17521: 
                   17522: # ------------------------------------------------------------- Get environment
                   17523: 
                   17524:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   17525:     my ($tmp) = keys(%userenv);
1.1275    raeburn  17526:     if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462     albertel 17527: 	undef(%userenv);
                   17528:     }
                   17529:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   17530: 	$form->{'interface'}=$userenv{'interface'};
                   17531:     }
                   17532:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   17533: 
                   17534: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   17535:     foreach my $option ('interface','localpath','localres') {
                   17536:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 17537:     }
                   17538: # --------------------------------------------------------- Write first profile
                   17539: 
                   17540:     {
1.1350    raeburn  17541:         my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462     albertel 17542: 	my %initial_env = 
                   17543: 	    ("user.name"          => $username,
                   17544: 	     "user.domain"        => $domain,
                   17545: 	     "user.home"          => $authhost,
                   17546: 	     "browser.type"       => $clientbrowser,
                   17547: 	     "browser.version"    => $clientversion,
                   17548: 	     "browser.mathml"     => $clientmathml,
                   17549: 	     "browser.unicode"    => $clientunicode,
                   17550: 	     "browser.os"         => $clientos,
1.1137    raeburn  17551:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  17552:              "browser.info"       => $clientinfo,
1.1194    raeburn  17553:              "browser.osversion"  => $clientosversion,
1.462     albertel 17554: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   17555: 	     "request.course.fn"  => '',
                   17556: 	     "request.course.uri" => '',
                   17557: 	     "request.course.sec" => '',
                   17558: 	     "request.role"       => 'cm',
                   17559: 	     "request.role.adv"   => $env{'user.adv'},
1.1350    raeburn  17560: 	     "request.host"       => $ip,);
1.462     albertel 17561: 
                   17562:         if ($form->{'localpath'}) {
                   17563: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   17564: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   17565:         }
                   17566: 	
                   17567: 	if ($form->{'interface'}) {
                   17568: 	    $form->{'interface'}=~s/\W//gs;
                   17569: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   17570: 	    $env{'browser.interface'}=$form->{'interface'};
                   17571: 	}
                   17572: 
1.1157    raeburn  17573:         if ($form->{'iptoken'}) {
                   17574:             my $lonhost = $r->dir_config('lonHostID');
                   17575:             $initial_env{"user.noloadbalance"} = $lonhost;
                   17576:             $env{'user.noloadbalance'} = $lonhost;
                   17577:         }
                   17578: 
1.1268    raeburn  17579:         if ($form->{'noloadbalance'}) {
                   17580:             my @hosts = &Apache::lonnet::current_machine_ids();
                   17581:             my $hosthere = $form->{'noloadbalance'};
                   17582:             if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   17583:                 $initial_env{"user.noloadbalance"} = $hosthere;
                   17584:                 $env{'user.noloadbalance'} = $hosthere;
                   17585:             }
                   17586:         }
                   17587: 
1.1016    raeburn  17588:         unless ($domain eq 'public') {
1.1273    raeburn  17589:             my %is_adv = ( is_adv => $env{'user.adv'} );
                   17590:             my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   17591: 
1.1387    raeburn  17592:             foreach my $tool ('aboutme','blog','webdav','portfolio','timezone') {
1.1273    raeburn  17593:                 $userenv{'availabletools.'.$tool} = 
                   17594:                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   17595:                                                       undef,\%userenv,\%domdef,\%is_adv);
                   17596:             }
1.980     raeburn  17597: 
1.1311    raeburn  17598:             foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273    raeburn  17599:                 $userenv{'canrequest.'.$crstype} =
                   17600:                     &Apache::lonnet::usertools_access($username,$domain,$crstype,
                   17601:                                                       'reload','requestcourses',
                   17602:                                                       \%userenv,\%domdef,\%is_adv);
                   17603:             }
1.724     raeburn  17604: 
1.1273    raeburn  17605:             $userenv{'canrequest.author'} =
                   17606:                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   17607:                                                   'reload','requestauthor',
1.980     raeburn  17608:                                                   \%userenv,\%domdef,\%is_adv);
1.1273    raeburn  17609:             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   17610:                                                  $domain,$username);
                   17611:             my $reqstatus = $reqauthor{'author_status'};
                   17612:             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   17613:                 if (ref($reqauthor{'author'}) eq 'HASH') {
                   17614:                     $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   17615:                                                       $reqauthor{'author'}{'timestamp'};
                   17616:                 }
1.1092    raeburn  17617:             }
1.1287    raeburn  17618:             my ($types,$typename) = &course_types();
                   17619:             if (ref($types) eq 'ARRAY') {
                   17620:                 my @options = ('approval','validate','autolimit');
                   17621:                 my $optregex = join('|',@options);
                   17622:                 my (%willtrust,%trustchecked);
                   17623:                 foreach my $type (@{$types}) {
                   17624:                     my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
                   17625:                     if ($dom_str ne '') {
                   17626:                         my $updatedstr = '';
                   17627:                         my @possdomains = split(',',$dom_str);
                   17628:                         foreach my $entry (@possdomains) {
                   17629:                             my ($extdom,$extopt) = split(':',$entry);
                   17630:                             unless ($trustchecked{$extdom}) {
                   17631:                                 $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
                   17632:                                 $trustchecked{$extdom} = 1;
                   17633:                             }
                   17634:                             if ($willtrust{$extdom}) {
                   17635:                                 $updatedstr .= $entry.',';
                   17636:                             }
                   17637:                         }
                   17638:                         $updatedstr =~ s/,$//;
                   17639:                         if ($updatedstr) {
                   17640:                             $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
                   17641:                         } else {
                   17642:                             delete($userenv{'reqcrsotherdom.'.$type});
                   17643:                         }
                   17644:                     }
                   17645:                 }
                   17646:             }
1.1092    raeburn  17647:         }
1.462     albertel 17648: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  17649: 
1.462     albertel 17650: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   17651: 		 &GDBM_WRCREAT(),0640)) {
                   17652: 	    &_add_to_env(\%disk_env,\%initial_env);
                   17653: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   17654: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  17655:             if (ref($firstaccenv) eq 'HASH') {
                   17656:                 &_add_to_env(\%disk_env,$firstaccenv);
                   17657:             }
                   17658:             if (ref($timerintenv) eq 'HASH') {
                   17659:                 &_add_to_env(\%disk_env,$timerintenv);
                   17660:             }
1.463     albertel 17661: 	    if (ref($args->{'extra_env'})) {
                   17662: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   17663: 	    }
1.462     albertel 17664: 	    untie(%disk_env);
                   17665: 	} else {
1.705     tempelho 17666: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   17667: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 17668: 	    return 'error: '.$!;
                   17669: 	}
                   17670:     }
                   17671:     $env{'request.role'}='cm';
                   17672:     $env{'request.role.adv'}=$env{'user.adv'};
                   17673:     $env{'browser.type'}=$clientbrowser;
                   17674: 
                   17675:     return $cookie;
                   17676: 
                   17677: }
                   17678: 
                   17679: sub _add_to_env {
                   17680:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  17681:     if (ref($env_data) eq 'HASH') {
                   17682:         while (my ($key,$value) = each(%$env_data)) {
                   17683: 	    $idf->{$prefix.$key} = $value;
                   17684: 	    $env{$prefix.$key}   = $value;
                   17685:         }
1.462     albertel 17686:     }
                   17687: }
                   17688: 
1.685     tempelho 17689: # --- Get the symbolic name of a problem and the url
                   17690: sub get_symb {
                   17691:     my ($request,$silent) = @_;
1.726     raeburn  17692:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 17693:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   17694:     if ($symb eq '') {
                   17695:         if (!$silent) {
1.1071    raeburn  17696:             if (ref($request)) { 
                   17697:                 $request->print("Unable to handle ambiguous references:$url:.");
                   17698:             }
1.685     tempelho 17699:             return ();
                   17700:         }
                   17701:     }
                   17702:     &Apache::lonenc::check_decrypt(\$symb);
                   17703:     return ($symb);
                   17704: }
                   17705: 
                   17706: # --------------------------------------------------------------Get annotation
                   17707: 
                   17708: sub get_annotation {
                   17709:     my ($symb,$enc) = @_;
                   17710: 
                   17711:     my $key = $symb;
                   17712:     if (!$enc) {
                   17713:         $key =
                   17714:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   17715:     }
                   17716:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   17717:     return $annotation{$key};
                   17718: }
                   17719: 
                   17720: sub clean_symb {
1.731     raeburn  17721:     my ($symb,$delete_enc) = @_;
1.685     tempelho 17722: 
                   17723:     &Apache::lonenc::check_decrypt(\$symb);
                   17724:     my $enc = $env{'request.enc'};
1.731     raeburn  17725:     if ($delete_enc) {
1.730     raeburn  17726:         delete($env{'request.enc'});
                   17727:     }
1.685     tempelho 17728: 
                   17729:     return ($symb,$enc);
                   17730: }
1.462     albertel 17731: 
1.1181    raeburn  17732: ############################################################
                   17733: ############################################################
                   17734: 
                   17735: =pod
                   17736: 
                   17737: =head1 Routines for building display used to search for courses
                   17738: 
                   17739: 
                   17740: =over 4
                   17741: 
                   17742: =item * &build_filters()
                   17743: 
                   17744: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  17745: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   17746: and quotacheck.pl
                   17747: 
1.1181    raeburn  17748: 
                   17749: Inputs:
                   17750: 
                   17751: filterlist - anonymous array of fields to include as potential filters 
                   17752: 
                   17753: crstype - course type
                   17754: 
                   17755: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   17756:               to pop-open a course selector (will contain "extra element"). 
                   17757: 
                   17758: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   17759: 
                   17760: filter - anonymous hash of criteria and their values
                   17761: 
                   17762: action - form action
                   17763: 
                   17764: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   17765: 
1.1182    raeburn  17766: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  17767: 
                   17768: cloneruname - username of owner of new course who wants to clone
                   17769: 
                   17770: clonerudom - domain of owner of new course who wants to clone
                   17771: 
                   17772: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   17773: 
                   17774: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   17775: 
                   17776: codedom - domain
                   17777: 
                   17778: formname - value of form element named "form". 
                   17779: 
                   17780: fixeddom - domain, if fixed.
                   17781: 
                   17782: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   17783: 
                   17784: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   17785: 
                   17786: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   17787: 
                   17788: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   17789: 
                   17790: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   17791: 
                   17792: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   17793: 
                   17794: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   17795: 
1.1182    raeburn  17796: 
1.1181    raeburn  17797: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   17798: 
1.1182    raeburn  17799: 
1.1181    raeburn  17800: Side Effects: None
                   17801: 
                   17802: =cut
                   17803: 
                   17804: # ---------------------------------------------- search for courses based on last activity etc.
                   17805: 
                   17806: sub build_filters {
                   17807:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   17808:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   17809:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   17810:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   17811:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  17812:     my ($list,$jscript);
1.1181    raeburn  17813:     my $onchange = 'javascript:updateFilters(this)';
                   17814:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   17815:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   17816:         $typeselectform,$instcodetitle);
                   17817:     if ($formname eq '') {
                   17818:         $formname = $caller;
                   17819:     }
                   17820:     foreach my $item (@{$filterlist}) {
                   17821:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   17822:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   17823:             if ($item eq 'domainfilter') {
                   17824:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   17825:             } elsif ($item eq 'coursefilter') {
                   17826:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   17827:             } elsif ($item eq 'ownerfilter') {
                   17828:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   17829:             } elsif ($item eq 'ownerdomfilter') {
                   17830:                 $filter->{'ownerdomfilter'} =
                   17831:                     &LONCAPA::clean_domain($filter->{$item});
                   17832:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   17833:                                                        'ownerdomfilter',1);
                   17834:             } elsif ($item eq 'personfilter') {
                   17835:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   17836:             } elsif ($item eq 'persondomfilter') {
                   17837:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   17838:                                                         'persondomfilter',1);
                   17839:             } else {
                   17840:                 $filter->{$item} =~ s/\W//g;
                   17841:             }
                   17842:             if (!$filter->{$item}) {
                   17843:                 $filter->{$item} = '';
                   17844:             }
                   17845:         }
                   17846:         if ($item eq 'domainfilter') {
                   17847:             my $allow_blank = 1;
                   17848:             if ($formname eq 'portform') {
                   17849:                 $allow_blank=0;
                   17850:             } elsif ($formname eq 'studentform') {
                   17851:                 $allow_blank=0;
                   17852:             }
                   17853:             if ($fixeddom) {
                   17854:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   17855:                                     ' value="'.$codedom.'" />'.
                   17856:                                     &Apache::lonnet::domain($codedom,'description');
                   17857:             } else {
                   17858:                 $domainselectform = &select_dom_form($filter->{$item},
                   17859:                                                      'domainfilter',
                   17860:                                                       $allow_blank,'',$onchange);
                   17861:             }
                   17862:         } else {
                   17863:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   17864:         }
                   17865:     }
                   17866: 
                   17867:     # last course activity filter and selection
                   17868:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   17869: 
                   17870:     # course created filter and selection
                   17871:     if (exists($filter->{'createdfilter'})) {
                   17872:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   17873:     }
                   17874: 
1.1239    raeburn  17875:     my $prefix = $crstype;
                   17876:     if ($crstype eq 'Placement') {
                   17877:         $prefix = 'Placement Test'
                   17878:     }
1.1181    raeburn  17879:     my %lt = &Apache::lonlocal::texthash(
1.1239    raeburn  17880:                 'cac' => "$prefix Activity",
                   17881:                 'ccr' => "$prefix Created",
                   17882:                 'cde' => "$prefix Title",
                   17883:                 'cdo' => "$prefix Domain",
1.1181    raeburn  17884:                 'ins' => 'Institutional Code',
                   17885:                 'inc' => 'Institutional Categorization',
1.1239    raeburn  17886:                 'cow' => "$prefix Owner/Co-owner",
                   17887:                 'cop' => "$prefix Personnel Includes",
1.1181    raeburn  17888:                 'cog' => 'Type',
                   17889:              );
                   17890: 
                   17891:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   17892:         my $typeval = 'Course';
                   17893:         if ($crstype eq 'Community') {
                   17894:             $typeval = 'Community';
1.1239    raeburn  17895:         } elsif ($crstype eq 'Placement') {
                   17896:             $typeval = 'Placement';
1.1181    raeburn  17897:         }
                   17898:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   17899:     } else {
                   17900:         $typeselectform =  '<select name="type" size="1"';
                   17901:         if ($onchange) {
                   17902:             $typeselectform .= ' onchange="'.$onchange.'"';
                   17903:         }
                   17904:         $typeselectform .= '>'."\n";
1.1237    raeburn  17905:         foreach my $posstype ('Course','Community','Placement') {
1.1239    raeburn  17906:             my $shown;
                   17907:             if ($posstype eq 'Placement') {
                   17908:                 $shown = &mt('Placement Test');
                   17909:             } else {
                   17910:                 $shown = &mt($posstype);
                   17911:             }
1.1181    raeburn  17912:             $typeselectform.='<option value="'.$posstype.'"'.
1.1239    raeburn  17913:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181    raeburn  17914:         }
                   17915:         $typeselectform.="</select>";
                   17916:     }
                   17917: 
                   17918:     my ($cloneableonlyform,$cloneabletitle);
                   17919:     if (exists($filter->{'cloneableonly'})) {
                   17920:         my $cloneableon = '';
                   17921:         my $cloneableoff = ' checked="checked"';
                   17922:         if ($filter->{'cloneableonly'}) {
                   17923:             $cloneableon = $cloneableoff;
                   17924:             $cloneableoff = '';
                   17925:         }
                   17926:         $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>';
                   17927:         if ($formname eq 'ccrs') {
1.1187    bisitz   17928:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181    raeburn  17929:         } else {
                   17930:             $cloneabletitle = &mt('Cloneable by you');
                   17931:         }
                   17932:     }
                   17933:     my $officialjs;
                   17934:     if ($crstype eq 'Course') {
                   17935:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  17936: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   17937: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   17938:             if ($codedom) { 
1.1181    raeburn  17939:                 $officialjs = 1;
                   17940:                 ($instcodeform,$jscript,$$numtitlesref) =
                   17941:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   17942:                                                                   $officialjs,$codetitlesref);
                   17943:                 if ($jscript) {
1.1182    raeburn  17944:                     $jscript = '<script type="text/javascript">'."\n".
                   17945:                                '// <![CDATA['."\n".
                   17946:                                $jscript."\n".
                   17947:                                '// ]]>'."\n".
                   17948:                                '</script>'."\n";
1.1181    raeburn  17949:                 }
                   17950:             }
                   17951:             if ($instcodeform eq '') {
                   17952:                 $instcodeform =
                   17953:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   17954:                     $list->{'instcodefilter'}.'" />';
                   17955:                 $instcodetitle = $lt{'ins'};
                   17956:             } else {
                   17957:                 $instcodetitle = $lt{'inc'};
                   17958:             }
                   17959:             if ($fixeddom) {
                   17960:                 $instcodetitle .= '<br />('.$codedom.')';
                   17961:             }
                   17962:         }
                   17963:     }
                   17964:     my $output = qq|
                   17965: <form method="post" name="filterpicker" action="$action">
                   17966: <input type="hidden" name="form" value="$formname" />
                   17967: |;
                   17968:     if ($formname eq 'modifycourse') {
                   17969:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   17970:                    '<input type="hidden" name="prevphase" value="'.
                   17971:                    $prevphase.'" />'."\n";
1.1198    musolffc 17972:     } elsif ($formname eq 'quotacheck') {
                   17973:         $output .= qq|
                   17974: <input type="hidden" name="sortby" value="" />
                   17975: <input type="hidden" name="sortorder" value="" />
                   17976: |;
                   17977:     } else {
1.1181    raeburn  17978:         my $name_input;
                   17979:         if ($cnameelement ne '') {
                   17980:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   17981:                           $cnameelement.'" />';
                   17982:         }
                   17983:         $output .= qq|
1.1182    raeburn  17984: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   17985: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  17986: $name_input
                   17987: $roleelement
                   17988: $multelement
                   17989: $typeelement
                   17990: |;
                   17991:         if ($formname eq 'portform') {
                   17992:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   17993:         }
                   17994:     }
                   17995:     if ($fixeddom) {
                   17996:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   17997:     }
                   17998:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   17999:     if ($sincefilterform) {
                   18000:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   18001:                   .$sincefilterform
                   18002:                   .&Apache::lonhtmlcommon::row_closure();
                   18003:     }
                   18004:     if ($createdfilterform) {
                   18005:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   18006:                   .$createdfilterform
                   18007:                   .&Apache::lonhtmlcommon::row_closure();
                   18008:     }
                   18009:     if ($domainselectform) {
                   18010:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   18011:                   .$domainselectform
                   18012:                   .&Apache::lonhtmlcommon::row_closure();
                   18013:     }
                   18014:     if ($typeselectform) {
                   18015:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   18016:             $output .= $typeselectform;
                   18017:         } else {
                   18018:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   18019:                       .$typeselectform
                   18020:                       .&Apache::lonhtmlcommon::row_closure();
                   18021:         }
                   18022:     }
                   18023:     if ($instcodeform) {
                   18024:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   18025:                   .$instcodeform
                   18026:                   .&Apache::lonhtmlcommon::row_closure();
                   18027:     }
                   18028:     if (exists($filter->{'ownerfilter'})) {
                   18029:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   18030:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   18031:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   18032:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   18033:                    $ownerdomselectform.'</td></tr></table>'.
                   18034:                    &Apache::lonhtmlcommon::row_closure();
                   18035:     }
                   18036:     if (exists($filter->{'personfilter'})) {
                   18037:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   18038:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   18039:                    '<input type="text" name="personfilter" size="20" value="'.
                   18040:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   18041:                    $persondomselectform.'</td></tr></table>'.
                   18042:                    &Apache::lonhtmlcommon::row_closure();
                   18043:     }
                   18044:     if (exists($filter->{'coursefilter'})) {
                   18045:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   18046:                   .'<input type="text" name="coursefilter" size="25" value="'
                   18047:                   .$list->{'coursefilter'}.'" />'
                   18048:                   .&Apache::lonhtmlcommon::row_closure();
                   18049:     }
                   18050:     if ($cloneableonlyform) {
                   18051:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   18052:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   18053:     }
                   18054:     if (exists($filter->{'descriptfilter'})) {
                   18055:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   18056:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   18057:                   .$list->{'descriptfilter'}.'" />'
                   18058:                   .&Apache::lonhtmlcommon::row_closure(1);
                   18059:     }
                   18060:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   18061:                '<input type="hidden" name="updater" value="" />'."\n".
                   18062:                '<input type="submit" name="gosearch" value="'.
                   18063:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   18064:     return $jscript.$clonewarning.$output;
                   18065: }
                   18066: 
                   18067: =pod 
                   18068: 
                   18069: =item * &timebased_select_form()
                   18070: 
1.1182    raeburn  18071: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  18072: filter e.g., Course Activity, Course Created, when searching for courses
                   18073: or communities
                   18074: 
                   18075: Inputs:
                   18076: 
                   18077: item - name of form element (sincefilter or createdfilter)
                   18078: 
                   18079: filter - anonymous hash of criteria and their values
                   18080: 
                   18081: Returns: HTML for a select box contained a blank, then six time selections,
                   18082:          with value set in incoming form variables currently selected. 
                   18083: 
                   18084: Side Effects: None
                   18085: 
                   18086: =cut
                   18087: 
                   18088: sub timebased_select_form {
                   18089:     my ($item,$filter) = @_;
                   18090:     if (ref($filter) eq 'HASH') {
                   18091:         $filter->{$item} =~ s/[^\d-]//g;
                   18092:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   18093:         return &select_form(
                   18094:                             $filter->{$item},
                   18095:                             $item,
                   18096:                             {      '-1' => '',
                   18097:                                 '86400' => &mt('today'),
                   18098:                                '604800' => &mt('last week'),
                   18099:                               '2592000' => &mt('last month'),
                   18100:                               '7776000' => &mt('last three months'),
                   18101:                              '15552000' => &mt('last six months'),
                   18102:                              '31104000' => &mt('last year'),
                   18103:                     'select_form_order' =>
                   18104:                            ['-1','86400','604800','2592000','7776000',
                   18105:                             '15552000','31104000']});
                   18106:     }
                   18107: }
                   18108: 
                   18109: =pod
                   18110: 
                   18111: =item * &js_changer()
                   18112: 
                   18113: Create script tag containing Javascript used to submit course search form
1.1183    raeburn  18114: when course type or domain is changed, and also to hide 'Searching ...' on
                   18115: page load completion for page showing search result.
1.1181    raeburn  18116: 
                   18117: Inputs: None
                   18118: 
1.1183    raeburn  18119: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  18120: 
                   18121: Side Effects: None
                   18122: 
                   18123: =cut
                   18124: 
                   18125: sub js_changer {
                   18126:     return <<ENDJS;
                   18127: <script type="text/javascript">
                   18128: // <![CDATA[
                   18129: function updateFilters(caller) {
                   18130:     if (typeof(caller) != "undefined") {
                   18131:         document.filterpicker.updater.value = caller.name;
                   18132:     }
                   18133:     document.filterpicker.submit();
                   18134: }
1.1183    raeburn  18135: 
                   18136: function hideSearching() {
                   18137:     if (document.getElementById('searching')) {
                   18138:         document.getElementById('searching').style.display = 'none';
                   18139:     }
                   18140:     return;
                   18141: }
                   18142: 
1.1181    raeburn  18143: // ]]>
                   18144: </script>
                   18145: 
                   18146: ENDJS
                   18147: }
                   18148: 
                   18149: =pod
                   18150: 
1.1182    raeburn  18151: =item * &search_courses()
                   18152: 
                   18153: Process selected filters form course search form and pass to lonnet::courseiddump
                   18154: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   18155: 
                   18156: Inputs:
                   18157: 
                   18158: dom - domain being searched 
                   18159: 
                   18160: type - course type ('Course' or 'Community' or '.' if any).
                   18161: 
                   18162: filter - anonymous hash of criteria and their values
                   18163: 
                   18164: numtitles - for institutional codes - number of categories
                   18165: 
                   18166: cloneruname - optional username of new course owner
                   18167: 
                   18168: clonerudom - optional domain of new course owner
                   18169: 
1.1221    raeburn  18170: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
1.1182    raeburn  18171:             (used when DC is using course creation form)
                   18172: 
                   18173: codetitles - reference to array of titles of components in institutional codes (official courses).
                   18174: 
1.1221    raeburn  18175: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   18176:            (and so can clone automatically)
                   18177: 
                   18178: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   18179: 
                   18180: reqinstcode - institutional code of new course, where search_courses is used to identify potential 
                   18181:               courses to clone 
1.1182    raeburn  18182: 
                   18183: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   18184: 
                   18185: 
                   18186: Side Effects: None
                   18187: 
                   18188: =cut
                   18189: 
                   18190: 
                   18191: sub search_courses {
1.1221    raeburn  18192:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   18193:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182    raeburn  18194:     my (%courses,%showcourses,$cloner);
                   18195:     if (($filter->{'ownerfilter'} ne '') ||
                   18196:         ($filter->{'ownerdomfilter'} ne '')) {
                   18197:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   18198:                                        $filter->{'ownerdomfilter'};
                   18199:     }
                   18200:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   18201:         if (!$filter->{$item}) {
                   18202:             $filter->{$item}='.';
                   18203:         }
                   18204:     }
                   18205:     my $now = time;
                   18206:     my $timefilter =
                   18207:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   18208:     my ($createdbefore,$createdafter);
                   18209:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   18210:         $createdbefore = $now;
                   18211:         $createdafter = $now-$filter->{'createdfilter'};
                   18212:     }
                   18213:     my ($instcodefilter,$regexpok);
                   18214:     if ($numtitles) {
                   18215:         if ($env{'form.official'} eq 'on') {
                   18216:             $instcodefilter =
                   18217:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   18218:             $regexpok = 1;
                   18219:         } elsif ($env{'form.official'} eq 'off') {
                   18220:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   18221:             unless ($instcodefilter eq '') {
                   18222:                 $regexpok = -1;
                   18223:             }
                   18224:         }
                   18225:     } else {
                   18226:         $instcodefilter = $filter->{'instcodefilter'};
                   18227:     }
                   18228:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   18229:     if ($type eq '') { $type = '.'; }
                   18230: 
                   18231:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   18232:         $cloner = $cloneruname.':'.$clonerudom;
                   18233:     }
                   18234:     %courses = &Apache::lonnet::courseiddump($dom,
                   18235:                                              $filter->{'descriptfilter'},
                   18236:                                              $timefilter,
                   18237:                                              $instcodefilter,
                   18238:                                              $filter->{'combownerfilter'},
                   18239:                                              $filter->{'coursefilter'},
                   18240:                                              undef,undef,$type,$regexpok,undef,undef,
1.1221    raeburn  18241:                                              undef,undef,$cloner,$cc_clone,
1.1182    raeburn  18242:                                              $filter->{'cloneableonly'},
                   18243:                                              $createdbefore,$createdafter,undef,
1.1221    raeburn  18244:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182    raeburn  18245:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   18246:         my $ccrole;
                   18247:         if ($type eq 'Community') {
                   18248:             $ccrole = 'co';
                   18249:         } else {
                   18250:             $ccrole = 'cc';
                   18251:         }
                   18252:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   18253:                                                      $filter->{'persondomfilter'},
                   18254:                                                      'userroles',undef,
                   18255:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   18256:                                                      $dom);
                   18257:         foreach my $role (keys(%rolehash)) {
                   18258:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   18259:             my $cid = $cdom.'_'.$cnum;
                   18260:             if (exists($courses{$cid})) {
                   18261:                 if (ref($courses{$cid}) eq 'HASH') {
                   18262:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   18263:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263    raeburn  18264:                             push(@{$courses{$cid}{roles}},$courserole);
1.1182    raeburn  18265:                         }
                   18266:                     } else {
                   18267:                         $courses{$cid}{roles} = [$courserole];
                   18268:                     }
                   18269:                     $showcourses{$cid} = $courses{$cid};
                   18270:                 }
                   18271:             }
                   18272:         }
                   18273:         %courses = %showcourses;
                   18274:     }
                   18275:     return %courses;
                   18276: }
                   18277: 
                   18278: =pod
                   18279: 
1.1181    raeburn  18280: =back
                   18281: 
1.1207    raeburn  18282: =head1 Routines for version requirements for current course.
                   18283: 
                   18284: =over 4
                   18285: 
                   18286: =item * &check_release_required()
                   18287: 
                   18288: Compares required LON-CAPA version with version on server, and
                   18289: if required version is newer looks for a server with the required version.
                   18290: 
                   18291: Looks first at servers in user's owen domain; if none suitable, looks at
                   18292: servers in course's domain are permitted to host sessions for user's domain.
                   18293: 
                   18294: Inputs:
                   18295: 
                   18296: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   18297: 
                   18298: $courseid - Course ID of current course
                   18299: 
                   18300: $rolecode - User's current role in course (for switchserver query string).
                   18301: 
                   18302: $required - LON-CAPA version needed by course (format: Major.Minor).
                   18303: 
                   18304: 
                   18305: Returns:
                   18306: 
                   18307: $switchserver - query string tp append to /adm/switchserver call (if 
                   18308:                 current server's LON-CAPA version is too old. 
                   18309: 
                   18310: $warning - Message is displayed if no suitable server could be found.
                   18311: 
                   18312: =cut
                   18313: 
                   18314: sub check_release_required {
                   18315:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   18316:     my ($switchserver,$warning);
                   18317:     if ($required ne '') {
                   18318:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   18319:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   18320:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   18321:             my $otherserver;
                   18322:             if (($major eq '' && $minor eq '') ||
                   18323:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   18324:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   18325:                 my $switchlcrev =
                   18326:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   18327:                                                            $userdomserver);
                   18328:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   18329:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   18330:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   18331:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   18332:                     if ($cdom ne $env{'user.domain'}) {
                   18333:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   18334:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   18335:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   18336:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   18337:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   18338:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   18339:                         my $canhost =
                   18340:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   18341:                                                               $coursedomserver,
                   18342:                                                               $remoterev,
                   18343:                                                               $udomdefaults{'remotesessions'},
                   18344:                                                               $defdomdefaults{'hostedsessions'});
                   18345: 
                   18346:                         if ($canhost) {
                   18347:                             $otherserver = $coursedomserver;
                   18348:                         } else {
                   18349:                             $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.");
                   18350:                         }
                   18351:                     } else {
                   18352:                         $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).");
                   18353:                     }
                   18354:                 } else {
                   18355:                     $otherserver = $userdomserver;
                   18356:                 }
                   18357:             }
                   18358:             if ($otherserver ne '') {
                   18359:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   18360:             }
                   18361:         }
                   18362:     }
                   18363:     return ($switchserver,$warning);
                   18364: }
                   18365: 
                   18366: =pod
                   18367: 
                   18368: =item * &check_release_result()
                   18369: 
                   18370: Inputs:
                   18371: 
                   18372: $switchwarning - Warning message if no suitable server found to host session.
                   18373: 
                   18374: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   18375:                 and current role.
                   18376: 
                   18377: Returns: HTML to display with information about requirement to switch server.
                   18378:          Either displaying warning with link to Roles/Courses screen or
                   18379:          display link to switchserver.
                   18380: 
1.1181    raeburn  18381: =cut
                   18382: 
1.1207    raeburn  18383: sub check_release_result {
                   18384:     my ($switchwarning,$switchserver) = @_;
                   18385:     my $output = &start_page('Selected course unavailable on this server').
                   18386:                  '<p class="LC_warning">';
                   18387:     if ($switchwarning) {
                   18388:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   18389:         if (&show_course()) {
                   18390:             $output .= &mt('Display courses');
                   18391:         } else {
                   18392:             $output .= &mt('Display roles');
                   18393:         }
                   18394:         $output .= '</a>';
                   18395:     } elsif ($switchserver) {
                   18396:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   18397:                    '<br />'.
                   18398:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   18399:                    &mt('Switch Server').
                   18400:                    '</a>';
                   18401:     }
                   18402:     $output .= '</p>'.&end_page();
                   18403:     return $output;
                   18404: }
                   18405: 
                   18406: =pod
                   18407: 
                   18408: =item * &needs_coursereinit()
                   18409: 
                   18410: Determine if course contents stored for user's session needs to be
                   18411: refreshed, because content has changed since "Big Hash" last tied.
                   18412: 
                   18413: Check for change is made if time last checked is more than 10 minutes ago
                   18414: (by default).
                   18415: 
                   18416: Inputs:
                   18417: 
                   18418: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   18419: 
                   18420: $interval (optional) - Time which may elapse (in s) between last check for content
                   18421:                        change in current course. (default: 600 s).  
                   18422: 
                   18423: Returns: an array; first element is:
                   18424: 
                   18425: =over 4
                   18426: 
                   18427: 'switch' - if content updates mean user's session
                   18428:            needs to be switched to a server running a newer LON-CAPA version
                   18429:  
                   18430: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   18431:            on current server hosting user's session                
                   18432: 
                   18433: ''       - if no action required.
                   18434: 
                   18435: =back
                   18436: 
                   18437: If first item element is 'switch':
                   18438: 
                   18439: second item is $switchwarning - Warning message if no suitable server found to host session. 
                   18440: 
                   18441: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   18442:                               and current role. 
                   18443: 
                   18444: otherwise: no other elements returned.
                   18445: 
                   18446: =back
                   18447: 
                   18448: =cut
                   18449: 
                   18450: sub needs_coursereinit {
                   18451:     my ($loncaparev,$interval) = @_;
                   18452:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   18453:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   18454:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   18455:     my $now = time;
                   18456:     if ($interval eq '') {
                   18457:         $interval = 600;
                   18458:     }
                   18459:     if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282    raeburn  18460:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372    raeburn  18461:         my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282    raeburn  18462:         if ($blocked) {
                   18463:             return ();
                   18464:         }
1.1391    raeburn  18465:         my $update;
                   18466:         my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   18467:         my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
                   18468:         if ($lastmainchange > $env{'request.course.tied'}) {
                   18469:             my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                   18470:             if ($needswitch) {
                   18471:                 return ('switch',$switchwarning,$switchserver);
                   18472:             }
                   18473:             $update = 'main';
                   18474:         }
                   18475:         if ($lastsuppchange > $env{'request.course.suppupdated'}) {
                   18476:             if ($update) {
                   18477:                 $update = 'both';
                   18478:             } else {
                   18479:                 my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                   18480:                 if ($needswitch) {
                   18481:                     return ('switch',$switchwarning,$switchserver);
                   18482:                 } else {
                   18483:                     $update = 'supp';
1.1207    raeburn  18484:                 }
                   18485:             }
1.1391    raeburn  18486:             return ($update);
                   18487:         }
                   18488:     }
                   18489:     return ();
                   18490: }
                   18491: 
                   18492: sub switch_for_update {
                   18493:     my ($loncaparev,$cdom,$cnum) = @_;
                   18494:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   18495:     if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   18496:         my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   18497:         if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   18498:             &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   18499:                                     $curr_reqd_hash{'internal.releaserequired'}});
                   18500:             my ($switchserver,$switchwarning) =
                   18501:                 &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   18502:                                         $curr_reqd_hash{'internal.releaserequired'});
                   18503:             if ($switchwarning ne '' || $switchserver ne '') {
                   18504:                 return ('switch',$switchwarning,$switchserver);
                   18505:             }
1.1207    raeburn  18506:         }
                   18507:     }
                   18508:     return ();
                   18509: }
1.1181    raeburn  18510: 
1.1083    raeburn  18511: sub update_content_constraints {
1.1395    raeburn  18512:     my ($cdom,$cnum,$chome,$cid) = @_;
1.1083    raeburn  18513:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   18514:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307    raeburn  18515:     my (%checkresponsetypes,%checkcrsrestypes);
1.1083    raeburn  18516:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236    raeburn  18517:         my ($item,$name,$value) = split(/:/,$key);
1.1083    raeburn  18518:         if ($item eq 'resourcetag') {
                   18519:             if ($name eq 'responsetype') {
                   18520:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   18521:             }
1.1307    raeburn  18522:         } elsif ($item eq 'course') {
                   18523:             if ($name eq 'courserestype') {
                   18524:                 $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
                   18525:             }
1.1083    raeburn  18526:         }
                   18527:     }
                   18528:     my $navmap = Apache::lonnavmaps::navmap->new();
                   18529:     if (defined($navmap)) {
1.1307    raeburn  18530:         my (%allresponses,%allcrsrestypes);
                   18531:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
                   18532:             if ($res->is_tool()) {
                   18533:                 if ($allcrsrestypes{'exttool'}) {
                   18534:                     $allcrsrestypes{'exttool'} ++;
                   18535:                 } else {
                   18536:                     $allcrsrestypes{'exttool'} = 1;
                   18537:                 }
                   18538:                 next;
                   18539:             }
1.1083    raeburn  18540:             my %responses = $res->responseTypes();
                   18541:             foreach my $key (keys(%responses)) {
                   18542:                 next unless(exists($checkresponsetypes{$key}));
                   18543:                 $allresponses{$key} += $responses{$key};
                   18544:             }
                   18545:         }
                   18546:         foreach my $key (keys(%allresponses)) {
                   18547:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   18548:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   18549:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   18550:             }
                   18551:         }
1.1307    raeburn  18552:         foreach my $key (keys(%allcrsrestypes)) {
1.1308    raeburn  18553:             my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307    raeburn  18554:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   18555:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   18556:             }
                   18557:         }
1.1083    raeburn  18558:         undef($navmap);
                   18559:     }
1.1391    raeburn  18560:     if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
1.1308    raeburn  18561:         my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
                   18562:         if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   18563:             ($reqdmajor,$reqdminor) = ($major,$minor);
                   18564:         }
                   18565:     }
1.1083    raeburn  18566:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   18567:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   18568:     }
                   18569:     return;
                   18570: }
                   18571: 
1.1110    raeburn  18572: sub allmaps_incourse {
                   18573:     my ($cdom,$cnum,$chome,$cid) = @_;
                   18574:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   18575:         $cid = $env{'request.course.id'};
                   18576:         $cdom = $env{'course.'.$cid.'.domain'};
                   18577:         $cnum = $env{'course.'.$cid.'.num'};
                   18578:         $chome = $env{'course.'.$cid.'.home'};
                   18579:     }
                   18580:     my %allmaps = ();
                   18581:     my $lastchange =
                   18582:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   18583:     if ($lastchange > $env{'request.course.tied'}) {
                   18584:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   18585:         unless ($ferr) {
1.1395    raeburn  18586:             &update_content_constraints($cdom,$cnum,$chome,$cid);
1.1110    raeburn  18587:         }
                   18588:     }
                   18589:     my $navmap = Apache::lonnavmaps::navmap->new();
                   18590:     if (defined($navmap)) {
                   18591:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   18592:             $allmaps{$res->src()} = 1;
                   18593:         }
                   18594:     }
                   18595:     return \%allmaps;
                   18596: }
                   18597: 
1.1083    raeburn  18598: sub parse_supplemental_title {
                   18599:     my ($title) = @_;
                   18600: 
                   18601:     my ($foldertitle,$renametitle);
                   18602:     if ($title =~ /&amp;&amp;&amp;/) {
                   18603:         $title = &HTML::Entites::decode($title);
                   18604:     }
                   18605:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   18606:         $renametitle=$4;
                   18607:         my ($time,$uname,$udom) = ($1,$2,$3);
                   18608:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   18609:         my $name =  &plainname($uname,$udom);
                   18610:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   18611:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
1.1401    raeburn  18612:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
1.1402    raeburn  18613:         if ($foldertitle ne '') {
1.1401    raeburn  18614:             $title .= ': <br />'.$foldertitle;
                   18615:         }
1.1083    raeburn  18616:     }
                   18617:     if (wantarray) {
                   18618:         return ($title,$foldertitle,$renametitle);
                   18619:     }
                   18620:     return $title;
                   18621: }
                   18622: 
1.1395    raeburn  18623: sub get_supplemental {
                   18624:     my ($cnum,$cdom,$ignorecache,$possdel)=@_;
                   18625:     my $hashid=$cnum.':'.$cdom;
                   18626:     my ($supplemental,$cached,$set_httprefs);
                   18627:     unless ($ignorecache) {
                   18628:         ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
                   18629:     }
                   18630:     unless (defined($cached)) {
                   18631:         my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
                   18632:         unless ($chome eq 'no_host') {
                   18633:             my @order = @LONCAPA::map::order;
                   18634:             my @resources = @LONCAPA::map::resources;
                   18635:             my @resparms = @LONCAPA::map::resparms;
                   18636:             my @zombies = @LONCAPA::map::zombies;
                   18637:             my ($errors,%ids,%hidden);
                   18638:             $errors =
                   18639:                 &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
                   18640:                                       $errors,$possdel,\%ids,\%hidden);
                   18641:             @LONCAPA::map::order = @order;
                   18642:             @LONCAPA::map::resources = @resources;
                   18643:             @LONCAPA::map::resparms = @resparms;
                   18644:             @LONCAPA::map::zombies = @zombies;
                   18645:             $set_httprefs = 1;
                   18646:             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   18647:                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});
                   18648:             }
                   18649:             $supplemental = {
                   18650:                                ids => \%ids,
                   18651:                                hidden => \%hidden,
                   18652:                             };
                   18653:             &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
                   18654:         }
                   18655:     }
                   18656:     return ($supplemental,$set_httprefs);
                   18657: }
                   18658: 
1.1143    raeburn  18659: sub recurse_supplemental {
1.1391    raeburn  18660:     my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
                   18661:     if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
                   18662:         my $mapnum;
                   18663:         if ($suppmap eq 'supplemental.sequence') {
                   18664:             $mapnum = 0;
                   18665:         } else {
                   18666:             ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
                   18667:         }
1.1143    raeburn  18668:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   18669:         if ($fatal) {
                   18670:             $errors ++;
                   18671:         } else {
1.1389    raeburn  18672:             my @order = @LONCAPA::map::order;
                   18673:             if (@order > 0) {
                   18674:                 my @resources = @LONCAPA::map::resources;
1.1391    raeburn  18675:                 my @resparms = @LONCAPA::map::resparms;
1.1389    raeburn  18676:                 foreach my $idx (@order) {
                   18677:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1143    raeburn  18678:                     if (($src ne '') && ($status eq 'res')) {
1.1391    raeburn  18679:                         my $id = $mapnum.':'.$idx;
                   18680:                         push(@{$suppids->{$src}},$id);
                   18681:                         if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
                   18682:                             $hiddensupp->{$id} = 1;
                   18683:                         }
1.1146    raeburn  18684:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1391    raeburn  18685:                             $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
                   18686:                                                             $hiddensupp,$hiddensupp->{$id});
1.1143    raeburn  18687:                         } else {
1.1391    raeburn  18688:                             my $allowed;
                   18689:                             if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
                   18690:                                 $allowed = 1;
                   18691:                             } elsif ($possdel) {
                   18692:                                 foreach my $item (@{$suppids->{$src}}) {
                   18693:                                     next if ($item eq $id);
                   18694:                                     unless ($hiddensupp->{$item}) {
                   18695:                                        $allowed = 1;
                   18696:                                        last;
                   18697:                                     }
                   18698:                                 }
                   18699:                                 if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
                   18700:                                     &Apache::lonnet::delenv('httpref.'.$src);
                   18701:                                 }
                   18702:                             }
                   18703:                             if ($allowed && (!exists($env{'httpref.'.$src}))) {
                   18704:                                 &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1308    raeburn  18705:                             }
1.1143    raeburn  18706:                         }
                   18707:                     }
                   18708:                 }
                   18709:             }
                   18710:         }
                   18711:     }
1.1391    raeburn  18712:     return $errors;
                   18713: }
                   18714: 
                   18715: sub set_supp_httprefs {
                   18716:     my ($cnum,$cdom,$supplemental,$possdel) = @_;
                   18717:     if (ref($supplemental) eq 'HASH') {
                   18718:         if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
                   18719:             foreach my $src (keys(%{$supplemental->{'ids'}})) {
                   18720:                 next if ($src =~ /\.sequence$/);
                   18721:                 if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
                   18722:                     my $allowed;
                   18723:                     if ($env{'request.role.adv'}) {
                   18724:                         $allowed = 1;
                   18725:                     } else {
                   18726:                         foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
                   18727:                             unless ($supplemental->{'hidden'}->{$id}) {
                   18728:                                 $allowed = 1;
                   18729:                                 last;
                   18730:                             }
                   18731:                         }
                   18732:                     }
                   18733:                     if (exists($env{'httpref.'.$src})) {
                   18734:                         if ($possdel) {
                   18735:                             unless ($allowed) {
                   18736:                                 &Apache::lonnet::delenv('httpref.'.$src);
                   18737:                             }
                   18738:                         }
                   18739:                     } elsif ($allowed) {
                   18740:                         &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
                   18741:                     }
                   18742:                 }
                   18743:             }
                   18744:             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   18745:                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});
                   18746:             }
                   18747:         }
                   18748:     }
                   18749: }
                   18750: 
                   18751: sub get_supp_parameter {
                   18752:     my ($resparm,$name)=@_;
                   18753:     return if ($resparm eq '');
                   18754:     my $value=undef;
                   18755:     my $ptype=undef;
                   18756:     foreach (split('&&&',$resparm)) {
                   18757:         my ($thistype,$thisname,$thisvalue)=split('___',$_);
                   18758:         if ($thisname eq $name) {
                   18759:             $value=$thisvalue;
                   18760:             $ptype=$thistype;
                   18761:         }
                   18762:     }
                   18763:     return $value;
1.1143    raeburn  18764: }
                   18765: 
1.1101    raeburn  18766: sub symb_to_docspath {
1.1267    raeburn  18767:     my ($symb,$navmapref) = @_;
                   18768:     return unless ($symb && ref($navmapref));
1.1101    raeburn  18769:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   18770:     if ($resurl=~/\.(sequence|page)$/) {
                   18771:         $mapurl=$resurl;
                   18772:     } elsif ($resurl eq 'adm/navmaps') {
                   18773:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   18774:     }
                   18775:     my $mapresobj;
1.1267    raeburn  18776:     unless (ref($$navmapref)) {
                   18777:         $$navmapref = Apache::lonnavmaps::navmap->new();
                   18778:     }
                   18779:     if (ref($$navmapref)) {
                   18780:         $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101    raeburn  18781:     }
                   18782:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   18783:     my $type=$2;
                   18784:     my $path;
                   18785:     if (ref($mapresobj)) {
                   18786:         my $pcslist = $mapresobj->map_hierarchy();
                   18787:         if ($pcslist ne '') {
                   18788:             foreach my $pc (split(/,/,$pcslist)) {
                   18789:                 next if ($pc <= 1);
1.1267    raeburn  18790:                 my $res = $$navmapref->getByMapPc($pc);
1.1101    raeburn  18791:                 if (ref($res)) {
                   18792:                     my $thisurl = $res->src();
                   18793:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   18794:                     my $thistitle = $res->title();
                   18795:                     $path .= '&'.
                   18796:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  18797:                              &escape($thistitle).
1.1101    raeburn  18798:                              ':'.$res->randompick().
                   18799:                              ':'.$res->randomout().
                   18800:                              ':'.$res->encrypted().
                   18801:                              ':'.$res->randomorder().
                   18802:                              ':'.$res->is_page();
                   18803:                 }
                   18804:             }
                   18805:         }
                   18806:         $path =~ s/^\&//;
                   18807:         my $maptitle = $mapresobj->title();
                   18808:         if ($mapurl eq 'default') {
1.1129    raeburn  18809:             $maptitle = 'Main Content';
1.1101    raeburn  18810:         }
                   18811:         $path .= (($path ne '')? '&' : '').
                   18812:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  18813:                  &escape($maptitle).
1.1101    raeburn  18814:                  ':'.$mapresobj->randompick().
                   18815:                  ':'.$mapresobj->randomout().
                   18816:                  ':'.$mapresobj->encrypted().
                   18817:                  ':'.$mapresobj->randomorder().
                   18818:                  ':'.$mapresobj->is_page();
                   18819:     } else {
                   18820:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   18821:         my $ispage = (($type eq 'page')? 1 : '');
                   18822:         if ($mapurl eq 'default') {
1.1129    raeburn  18823:             $maptitle = 'Main Content';
1.1101    raeburn  18824:         }
                   18825:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  18826:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  18827:     }
                   18828:     unless ($mapurl eq 'default') {
                   18829:         $path = 'default&'.
1.1146    raeburn  18830:                 &escape('Main Content').
1.1101    raeburn  18831:                 ':::::&'.$path;
                   18832:     }
                   18833:     return $path;
                   18834: }
                   18835: 
1.1393    raeburn  18836: sub validate_folderpath {
                   18837:     my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
                   18838:     if ($env{'form.folderpath'} ne '') {
                   18839:         my @items = split(/\&/,$env{'form.folderpath'});
1.1394    raeburn  18840:         my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
1.1393    raeburn  18841:         for (my $i=0; $i<@items; $i++) {
                   18842:             my $odd = $i%2;
                   18843:             if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
                   18844:                 $badpath = 1;
1.1394    raeburn  18845:             } elsif ($odd && $supplementalflag) {
1.1393    raeburn  18846:                 my $idx = $i-1;
1.1394    raeburn  18847:                 if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
                   18848:                     my $esc_name = $1;
                   18849:                     if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
                   18850:                         $supppath .= '&'.$esc_name;
                   18851:                         $changed = 1;
                   18852:                     } else {
                   18853:                         $supppath .= '&'.$items[$i];
                   18854:                     }
                   18855:                 } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
                   18856:                     $changed = 1;
1.1393    raeburn  18857:                     my $is_hidden;
                   18858:                     unless ($got_supp) {
1.1395    raeburn  18859:                         my ($supplemental) = &get_supplemental($coursenum,$coursedom);
1.1393    raeburn  18860:                         if (ref($supplemental) eq 'HASH') {
                   18861:                             if (ref($supplemental->{'hidden'}) eq 'HASH') {
                   18862:                                 %supphidden = %{$supplemental->{'hidden'}};
                   18863:                             }
                   18864:                             if (ref($supplemental->{'ids'}) eq 'HASH') {
                   18865:                                 %suppids = %{$supplemental->{'ids'}};
                   18866:                             }
                   18867:                         }
                   18868:                         $got_supp = 1;
                   18869:                     }
                   18870:                     if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
                   18871:                         my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
                   18872:                         if ($supphidden{$mapid}) {
                   18873:                             $is_hidden = 1;
                   18874:                         }
                   18875:                     }
1.1394    raeburn  18876:                     $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
                   18877:                 } else {
                   18878:                     $supppath .= '&'.$items[$i];
1.1393    raeburn  18879:                 }
                   18880:             } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
                   18881:                 $badpath = 1;
1.1394    raeburn  18882:             } elsif ($supplementalflag) {
1.1393    raeburn  18883:                 $supppath .= '&'.$items[$i];
                   18884:             }
                   18885:             last if ($badpath);
                   18886:         }
                   18887:         if ($badpath) {
                   18888:             delete($env{'form.folderpath'});
1.1394    raeburn  18889:         } elsif ($changed && $supplementalflag) {
1.1393    raeburn  18890:             $supppath =~ s/^\&//;
                   18891:             $env{'form.folderpath'} = $supppath;
                   18892:         }
                   18893:     }
                   18894:     return;
                   18895: }
                   18896: 
1.1094    raeburn  18897: sub captcha_display {
1.1327    raeburn  18898:     my ($context,$lonhost,$defdom) = @_;
1.1094    raeburn  18899:     my ($output,$error);
1.1234    raeburn  18900:     my ($captcha,$pubkey,$privkey,$version) = 
1.1327    raeburn  18901:         &get_captcha_config($context,$lonhost,$defdom);
1.1095    raeburn  18902:     if ($captcha eq 'original') {
1.1094    raeburn  18903:         $output = &create_captcha();
                   18904:         unless ($output) {
1.1172    raeburn  18905:             $error = 'captcha';
1.1094    raeburn  18906:         }
                   18907:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  18908:         $output = &create_recaptcha($pubkey,$version);
1.1094    raeburn  18909:         unless ($output) {
1.1172    raeburn  18910:             $error = 'recaptcha';
1.1094    raeburn  18911:         }
                   18912:     }
1.1234    raeburn  18913:     return ($output,$error,$captcha,$version);
1.1094    raeburn  18914: }
                   18915: 
                   18916: sub captcha_response {
1.1327    raeburn  18917:     my ($context,$lonhost,$defdom) = @_;
1.1094    raeburn  18918:     my ($captcha_chk,$captcha_error);
1.1327    raeburn  18919:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095    raeburn  18920:     if ($captcha eq 'original') {
1.1094    raeburn  18921:         ($captcha_chk,$captcha_error) = &check_captcha();
                   18922:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  18923:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1094    raeburn  18924:     } else {
                   18925:         $captcha_chk = 1;
                   18926:     }
                   18927:     return ($captcha_chk,$captcha_error);
                   18928: }
                   18929: 
                   18930: sub get_captcha_config {
1.1327    raeburn  18931:     my ($context,$lonhost,$dom_in_effect) = @_;
1.1234    raeburn  18932:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094    raeburn  18933:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   18934:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   18935:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  18936:     if ($context eq 'usercreation') {
                   18937:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   18938:         if (ref($domconfig{$context}) eq 'HASH') {
                   18939:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   18940:             if (ref($hashtocheck) eq 'HASH') {
                   18941:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   18942:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   18943:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   18944:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   18945:                     }
                   18946:                     if ($privkey && $pubkey) {
                   18947:                         $captcha = 'recaptcha';
1.1234    raeburn  18948:                         $version = $hashtocheck->{'recaptchaversion'};
                   18949:                         if ($version ne '2') {
                   18950:                             $version = 1;
                   18951:                         }
1.1095    raeburn  18952:                     } else {
                   18953:                         $captcha = 'original';
                   18954:                     }
                   18955:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   18956:                     $captcha = 'original';
                   18957:                 }
1.1094    raeburn  18958:             }
1.1095    raeburn  18959:         } else {
                   18960:             $captcha = 'captcha';
                   18961:         }
                   18962:     } elsif ($context eq 'login') {
                   18963:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   18964:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   18965:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   18966:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  18967:             if ($privkey && $pubkey) {
                   18968:                 $captcha = 'recaptcha';
1.1234    raeburn  18969:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   18970:                 if ($version ne '2') {
                   18971:                     $version = 1; 
                   18972:                 }
1.1095    raeburn  18973:             } else {
                   18974:                 $captcha = 'original';
1.1094    raeburn  18975:             }
1.1095    raeburn  18976:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   18977:             $captcha = 'original';
1.1094    raeburn  18978:         }
1.1327    raeburn  18979:     } elsif ($context eq 'passwords') {
                   18980:         if ($dom_in_effect) {
                   18981:             my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
                   18982:             if ($passwdconf{'captcha'} eq 'recaptcha') {
                   18983:                 if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
                   18984:                     $pubkey = $passwdconf{'recaptchakeys'}{'public'};
                   18985:                     $privkey = $passwdconf{'recaptchakeys'}{'private'};
                   18986:                 }
                   18987:                 if ($privkey && $pubkey) {
                   18988:                     $captcha = 'recaptcha';
                   18989:                     $version = $passwdconf{'recaptchaversion'};
                   18990:                     if ($version ne '2') {
                   18991:                         $version = 1;
                   18992:                     }
                   18993:                 } else {
                   18994:                     $captcha = 'original';
                   18995:                 }
                   18996:             } elsif ($passwdconf{'captcha'} ne 'notused') {
                   18997:                 $captcha = 'original';
                   18998:             }
                   18999:         }
                   19000:     } 
1.1234    raeburn  19001:     return ($captcha,$pubkey,$privkey,$version);
1.1094    raeburn  19002: }
                   19003: 
                   19004: sub create_captcha {
                   19005:     my %captcha_params = &captcha_settings();
                   19006:     my ($output,$maxtries,$tries) = ('',10,0);
                   19007:     while ($tries < $maxtries) {
                   19008:         $tries ++;
                   19009:         my $captcha = Authen::Captcha->new (
                   19010:                                            output_folder => $captcha_params{'output_dir'},
                   19011:                                            data_folder   => $captcha_params{'db_dir'},
                   19012:                                           );
                   19013:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   19014: 
                   19015:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   19016:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367    raeburn  19017:                       '<span class="LC_nobreak">'.
1.1094    raeburn  19018:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1390    raeburn  19019:                       '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1367    raeburn  19020:                       '</span><br />'.
1.1176    raeburn  19021:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  19022:             last;
                   19023:         }
                   19024:     }
1.1323    raeburn  19025:     if ($output eq '') {
                   19026:         &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
                   19027:     }
1.1094    raeburn  19028:     return $output;
                   19029: }
                   19030: 
                   19031: sub captcha_settings {
                   19032:     my %captcha_params = (
                   19033:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   19034:                            www_output_dir => "/captchaspool",
                   19035:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   19036:                            numchars       => '5',
                   19037:                          );
                   19038:     return %captcha_params;
                   19039: }
                   19040: 
                   19041: sub check_captcha {
                   19042:     my ($captcha_chk,$captcha_error);
                   19043:     my $code = $env{'form.code'};
                   19044:     my $md5sum = $env{'form.crypt'};
                   19045:     my %captcha_params = &captcha_settings();
                   19046:     my $captcha = Authen::Captcha->new(
                   19047:                       output_folder => $captcha_params{'output_dir'},
                   19048:                       data_folder   => $captcha_params{'db_dir'},
                   19049:                   );
1.1109    raeburn  19050:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  19051:     my %captcha_hash = (
                   19052:                         0       => 'Code not checked (file error)',
                   19053:                        -1      => 'Failed: code expired',
                   19054:                        -2      => 'Failed: invalid code (not in database)',
                   19055:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   19056:     );
                   19057:     if ($captcha_chk != 1) {
                   19058:         $captcha_error = $captcha_hash{$captcha_chk}
                   19059:     }
                   19060:     return ($captcha_chk,$captcha_error);
                   19061: }
                   19062: 
                   19063: sub create_recaptcha {
1.1234    raeburn  19064:     my ($pubkey,$version) = @_;
                   19065:     if ($version >= 2) {
1.1367    raeburn  19066:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
                   19067:                '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234    raeburn  19068:     } else {
                   19069:         my $use_ssl;
                   19070:         if ($ENV{'SERVER_PORT'} == 443) {
                   19071:             $use_ssl = 1;
                   19072:         }
                   19073:         my $captcha = Captcha::reCAPTCHA->new;
                   19074:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   19075:                $captcha->get_html($pubkey,undef,$use_ssl).
                   19076:                &mt('If the text is hard to read, [_1] will replace them.',
                   19077:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   19078:                '<br /><br />';
                   19079:     }
1.1094    raeburn  19080: }
                   19081: 
                   19082: sub check_recaptcha {
1.1234    raeburn  19083:     my ($privkey,$version) = @_;
1.1094    raeburn  19084:     my $captcha_chk;
1.1350    raeburn  19085:     my $ip = &Apache::lonnet::get_requestor_ip();
1.1234    raeburn  19086:     if ($version >= 2) {
                   19087:         my %info = (
                   19088:                      secret   => $privkey, 
                   19089:                      response => $env{'form.g-recaptcha-response'},
1.1350    raeburn  19090:                      remoteip => $ip,
1.1234    raeburn  19091:                    );
1.1280    raeburn  19092:         my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
                   19093:         $request->content(join('&',map {
                   19094:                          my $name = escape($_);
                   19095:                          "$name=" . ( ref($info{$_}) eq 'ARRAY'
                   19096:                          ? join("&$name=", map {escape($_) } @{$info{$_}})
                   19097:                          : &escape($info{$_}) );
                   19098:         } keys(%info)));
                   19099:         my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234    raeburn  19100:         if ($response->is_success)  {
                   19101:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   19102:             if (ref($data) eq 'HASH') {
                   19103:                 if ($data->{'success'}) {
                   19104:                     $captcha_chk = 1;
                   19105:                 }
                   19106:             }
                   19107:         }
                   19108:     } else {
                   19109:         my $captcha = Captcha::reCAPTCHA->new;
                   19110:         my $captcha_result =
                   19111:             $captcha->check_answer(
                   19112:                                     $privkey,
1.1350    raeburn  19113:                                     $ip,
1.1234    raeburn  19114:                                     $env{'form.recaptcha_challenge_field'},
                   19115:                                     $env{'form.recaptcha_response_field'},
                   19116:                                   );
                   19117:         if ($captcha_result->{is_valid}) {
                   19118:             $captcha_chk = 1;
                   19119:         }
1.1094    raeburn  19120:     }
                   19121:     return $captcha_chk;
                   19122: }
                   19123: 
1.1174    raeburn  19124: sub emailusername_info {
1.1244    raeburn  19125:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174    raeburn  19126:     my %titles = &Apache::lonlocal::texthash (
                   19127:                      lastname      => 'Last Name',
                   19128:                      firstname     => 'First Name',
                   19129:                      institution   => 'School/college/university',
                   19130:                      location      => "School's city, state/province, country",
                   19131:                      web           => "School's web address",
                   19132:                      officialemail => 'E-mail address at institution (if different)',
1.1244    raeburn  19133:                      id            => 'Student/Employee ID',
1.1174    raeburn  19134:                  );
                   19135:     return (\@fields,\%titles);
                   19136: }
                   19137: 
1.1161    raeburn  19138: sub cleanup_html {
                   19139:     my ($incoming) = @_;
                   19140:     my $outgoing;
                   19141:     if ($incoming ne '') {
                   19142:         $outgoing = $incoming;
                   19143:         $outgoing =~ s/;/&#059;/g;
                   19144:         $outgoing =~ s/\#/&#035;/g;
                   19145:         $outgoing =~ s/\&/&#038;/g;
                   19146:         $outgoing =~ s/</&#060;/g;
                   19147:         $outgoing =~ s/>/&#062;/g;
                   19148:         $outgoing =~ s/\(/&#040/g;
                   19149:         $outgoing =~ s/\)/&#041;/g;
                   19150:         $outgoing =~ s/"/&#034;/g;
                   19151:         $outgoing =~ s/'/&#039;/g;
                   19152:         $outgoing =~ s/\$/&#036;/g;
                   19153:         $outgoing =~ s{/}{&#047;}g;
                   19154:         $outgoing =~ s/=/&#061;/g;
                   19155:         $outgoing =~ s/\\/&#092;/g
                   19156:     }
                   19157:     return $outgoing;
                   19158: }
                   19159: 
1.1190    musolffc 19160: # Checks for critical messages and returns a redirect url if one exists.
                   19161: # $interval indicates how often to check for messages.
1.1282    raeburn  19162: # $context is the calling context -- roles, grades, contents, menu or flip. 
1.1190    musolffc 19163: sub critical_redirect {
1.1282    raeburn  19164:     my ($interval,$context) = @_;
1.1356    raeburn  19165:     unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
                   19166:         return ();
                   19167:     }
1.1190    musolffc 19168:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282    raeburn  19169:         if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
                   19170:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   19171:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372    raeburn  19172:             my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282    raeburn  19173:             if ($blocked) {
                   19174:                 my $checkrole = "cm./$cdom/$cnum";
                   19175:                 if ($env{'request.course.sec'} ne '') {
                   19176:                     $checkrole .= "/$env{'request.course.sec'}";
                   19177:                 }
                   19178:                 unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   19179:                         ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   19180:                     return;
                   19181:                 }
                   19182:             }
                   19183:         }
1.1190    musolffc 19184:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                   19185:                                         $env{'user.name'});
                   19186:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191    raeburn  19187:         my $redirecturl;
1.1190    musolffc 19188:         if ($what[0]) {
1.1356    raeburn  19189: 	    if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190    musolffc 19190: 	        $redirecturl='/adm/email?critical=display';
1.1191    raeburn  19191: 	        my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   19192:                 return (1, $url);
1.1190    musolffc 19193:             }
1.1191    raeburn  19194:         }
                   19195:     } 
                   19196:     return ();
1.1190    musolffc 19197: }
                   19198: 
1.1174    raeburn  19199: # Use:
                   19200: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   19201: #
                   19202: ##################################################
                   19203: #          password associated functions         #
                   19204: ##################################################
                   19205: sub des_keys {
                   19206:     # Make a new key for DES encryption.
                   19207:     # Each key has two parts which are returned separately.
                   19208:     # Please note:  Each key must be passed through the &hex function
                   19209:     # before it is output to the web browser.  The hex versions cannot
                   19210:     # be used to decrypt.
                   19211:     my @hexstr=('0','1','2','3','4','5','6','7',
                   19212:                 '8','9','a','b','c','d','e','f');
                   19213:     my $lkey='';
                   19214:     for (0..7) {
                   19215:         $lkey.=$hexstr[rand(15)];
                   19216:     }
                   19217:     my $ukey='';
                   19218:     for (0..7) {
                   19219:         $ukey.=$hexstr[rand(15)];
                   19220:     }
                   19221:     return ($lkey,$ukey);
                   19222: }
                   19223: 
                   19224: sub des_decrypt {
                   19225:     my ($key,$cyphertext) = @_;
                   19226:     my $keybin=pack("H16",$key);
                   19227:     my $cypher;
                   19228:     if ($Crypt::DES::VERSION>=2.03) {
                   19229:         $cypher=new Crypt::DES $keybin;
                   19230:     } else {
                   19231:         $cypher=new DES $keybin;
                   19232:     }
1.1233    raeburn  19233:     my $plaintext='';
                   19234:     my $cypherlength = length($cyphertext);
                   19235:     my $numchunks = int($cypherlength/32);
                   19236:     for (my $j=0; $j<$numchunks; $j++) {
                   19237:         my $start = $j*32;
                   19238:         my $cypherblock = substr($cyphertext,$start,32);
                   19239:         my $chunk =
                   19240:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   19241:         $chunk .=
                   19242:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   19243:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   19244:         $plaintext .= $chunk;
                   19245:     }
1.1174    raeburn  19246:     return $plaintext;
                   19247: }
                   19248: 
1.1344    raeburn  19249: sub get_requested_shorturls {
1.1309    raeburn  19250:     my ($cdom,$cnum,$navmap) = @_;
                   19251:     return unless (ref($navmap));
1.1344    raeburn  19252:     my ($numnew,$errors);
1.1309    raeburn  19253:     my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
                   19254:     if (@toshorten) {
                   19255:         my (%maps,%resources,%titles);
                   19256:         &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                   19257:                                                                'shorturls',$cdom,$cnum);
                   19258:         if (keys(%resources)) {
1.1344    raeburn  19259:             my %tocreate;
1.1309    raeburn  19260:             foreach my $item (sort {$a <=> $b} (@toshorten)) {
                   19261:                 my $symb = $resources{$item};
                   19262:                 if ($symb) {
                   19263:                     $tocreate{$cnum.'&'.$symb} = 1;
                   19264:                 }
                   19265:             }
1.1344    raeburn  19266:             if (keys(%tocreate)) {
                   19267:                 ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
                   19268:                                                       \%tocreate);
                   19269:             }
1.1309    raeburn  19270:         }
1.1344    raeburn  19271:     }
                   19272:     return ($numnew,$errors);
                   19273: }
                   19274: 
                   19275: sub make_short_symbs {
                   19276:     my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
                   19277:     my ($numnew,@errors);
                   19278:     if (ref($tocreateref) eq 'HASH') {
                   19279:         my %tocreate = %{$tocreateref};
1.1309    raeburn  19280:         if (keys(%tocreate)) {
                   19281:             my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
                   19282:             my $su = Short::URL->new(no_vowels => 1);
                   19283:             my $init = '';
                   19284:             my (%newunique,%addcourse,%courseonly,%failed);
                   19285:             # get lock on tiny db
                   19286:             my $now = time;
1.1344    raeburn  19287:             if ($lockuser eq '') {
                   19288:                 $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
                   19289:             }
1.1309    raeburn  19290:             my $lockhash = {
1.1344    raeburn  19291:                                 "lock\0$now" => $lockuser,
1.1309    raeburn  19292:                             };
                   19293:             my $tries = 0;
                   19294:             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
                   19295:             my ($code,$error);
                   19296:             while (($gotlock ne 'ok') && ($tries<3)) {
                   19297:                 $tries ++;
                   19298:                 sleep 1;
1.1319    raeburn  19299:                 $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309    raeburn  19300:             }
                   19301:             if ($gotlock eq 'ok') {
                   19302:                 $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
                   19303:                                        \%addcourse,\%courseonly,\%failed);
                   19304:                 if (keys(%failed)) {
                   19305:                     my $numfailed = scalar(keys(%failed));
                   19306:                     push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
                   19307:                 }
                   19308:                 if (keys(%newunique)) {
                   19309:                     my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
                   19310:                     if ($putres eq 'ok') {
                   19311:                         $numnew = scalar(keys(%newunique));
                   19312:                         my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
                   19313:                         unless ($newputres eq 'ok') {
                   19314:                             push(@errors,&mt('error: could not store course look-up of short URLs'));
                   19315:                         }
                   19316:                     } else {
                   19317:                         push(@errors,&mt('error: could not store unique six character URLs'));
                   19318:                     }
                   19319:                 }
                   19320:                 my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
                   19321:                 unless ($dellockres eq 'ok') {
                   19322:                     push(@errors,&mt('error: could not release lockfile'));
                   19323:                 }
                   19324:             } else {
                   19325:                 push(@errors,&mt('error: could not obtain lockfile'));
                   19326:             }
                   19327:             if (keys(%courseonly)) {
                   19328:                 my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
                   19329:                 if ($result ne 'ok') {
                   19330:                     push(@errors,&mt('error: could not update course look-up of short URLs'));
                   19331:                 }
                   19332:             }
                   19333:         }
                   19334:     }
                   19335:     return ($numnew,\@errors);
                   19336: }
                   19337: 
                   19338: sub shorten_symbs {
                   19339:     my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
                   19340:     return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
                   19341:                    (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
                   19342:                    (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
                   19343:     my (%possibles,%collisions);
                   19344:     foreach my $key (keys(%{$tocreate})) {
                   19345:         my $num = String::CRC32::crc32($key);
                   19346:         my $tiny = $su->encode($num,$init);
                   19347:         if ($tiny) {
                   19348:             $possibles{$tiny} = $key;
                   19349:         }
                   19350:     }
                   19351:     if (!$init) {
                   19352:         $init = 1;
                   19353:     } else {
                   19354:         $init ++;
                   19355:     }
                   19356:     if (keys(%possibles)) {
                   19357:         my @posstiny = keys(%possibles);
                   19358:         my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                   19359:         my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
                   19360:         if (keys(%currtiny)) {
                   19361:             foreach my $key (keys(%currtiny)) {
                   19362:                 next if ($currtiny{$key} eq '');
                   19363:                 if ($currtiny{$key} eq $possibles{$key}) {
                   19364:                     my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
                   19365:                     unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                   19366:                         $courseonly->{$tsymb} = $key;
                   19367:                     }
                   19368:                 } else {
                   19369:                     $collisions{$possibles{$key}} = 1;
                   19370:                 }
                   19371:                 delete($possibles{$key});
                   19372:             }
                   19373:         }
                   19374:         foreach my $key (keys(%possibles)) {
                   19375:             $newunique->{$key} = $possibles{$key};
                   19376:             my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
                   19377:             unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                   19378:                 $addcourse->{$tsymb} = $key;
                   19379:             }
                   19380:         }
                   19381:     }
                   19382:     if (keys(%collisions)) {
                   19383:         if ($init <5) {
                   19384:             if (!$init) {
                   19385:                 $init = 1;
                   19386:             } else {
                   19387:                 $init ++;
                   19388:             }
                   19389:             $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
                   19390:                                    $newunique,$addcourse,$courseonly,$failed);
                   19391:         } else {
                   19392:             foreach my $key (keys(%collisions)) {
                   19393:                 $failed->{$key} = 1;
                   19394:             }
                   19395:         }
                   19396:     }
                   19397:     return $init;
                   19398: }
                   19399: 
1.1328    raeburn  19400: sub is_nonframeable {
1.1329    raeburn  19401:     my ($url,$absolute,$hostname,$ip,$nocache) = @_;
                   19402:     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330    raeburn  19403:     return if (($remprotocol eq '') || ($remhost eq ''));
1.1329    raeburn  19404: 
                   19405:     $remprotocol = lc($remprotocol);
                   19406:     $remhost = lc($remhost);
                   19407:     my $remport = 80;
                   19408:     if ($remprotocol eq 'https') {
                   19409:         $remport = 443;
                   19410:     }
1.1330    raeburn  19411:     my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329    raeburn  19412:     if ($cached) {
                   19413:         unless ($nocache) {
                   19414:             if ($result) {
                   19415:                 return 1;
                   19416:             } else {
                   19417:                 return 0;
                   19418:             }
                   19419:         }
                   19420:     }
1.1328    raeburn  19421:     my $uselink;
                   19422:     my $request = new HTTP::Request('HEAD',$url);
                   19423:     my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
                   19424:     if ($response->is_success()) {
                   19425:         my $secpolicy = lc($response->header('content-security-policy'));
                   19426:         my $xframeop = lc($response->header('x-frame-options'));
                   19427:         $secpolicy =~ s/^\s+|\s+$//g;
                   19428:         $xframeop =~ s/^\s+|\s+$//g;
                   19429:         if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329    raeburn  19430:             my $remotehost = $remprotocol.'://'.$remhost;
1.1328    raeburn  19431:             my ($origin,$protocol,$port);
                   19432:             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                   19433:                 $port = $ENV{'SERVER_PORT'};
                   19434:             } else {
                   19435:                 $port = 80;
                   19436:             }
                   19437:             if ($absolute eq '') {
                   19438:                 $protocol = 'http:';
                   19439:                 if ($port == 443) {
                   19440:                     $protocol = 'https:';
                   19441:                 }
                   19442:                 $origin = $protocol.'//'.lc($hostname);
                   19443:             } else {
                   19444:                 $origin = lc($absolute);
                   19445:                 ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
                   19446:             }
                   19447:             if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
                   19448:                 my $framepolicy = $1;
                   19449:                 $framepolicy =~ s/^\s+|\s+$//g;
                   19450:                 my @policies = split(/\s+/,$framepolicy);
                   19451:                 if (@policies) {
                   19452:                     if (grep(/^\Q'none'\E$/,@policies)) {
                   19453:                         $uselink = 1;
                   19454:                     } else {
                   19455:                         $uselink = 1;
                   19456:                         if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
                   19457:                                 (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
                   19458:                                 (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
                   19459:                             undef($uselink);
                   19460:                         }
                   19461:                         if ($uselink) {
                   19462:                             if (grep(/^\Q'self'\E$/,@policies)) {
                   19463:                                 if (($origin ne '') && ($remotehost eq $origin)) {
                   19464:                                     undef($uselink);
                   19465:                                 }
                   19466:                             }
                   19467:                         }
                   19468:                         if ($uselink) {
                   19469:                             my @possok;
                   19470:                             if ($ip ne '') {
                   19471:                                 push(@possok,$ip);
                   19472:                             }
                   19473:                             my $hoststr = '';
                   19474:                             foreach my $part (reverse(split(/\./,$hostname))) {
                   19475:                                 if ($hoststr eq '') {
                   19476:                                     $hoststr = $part;
                   19477:                                 } else {
                   19478:                                     $hoststr = "$part.$hoststr";
                   19479:                                 }
                   19480:                                 if ($hoststr eq $hostname) {
                   19481:                                     push(@possok,$hostname);
                   19482:                                 } else {
                   19483:                                     push(@possok,"*.$hoststr");
                   19484:                                 }
                   19485:                             }
                   19486:                             if (@possok) {
                   19487:                                 foreach my $poss (@possok) {
                   19488:                                     last if (!$uselink);
                   19489:                                     foreach my $policy (@policies) {
                   19490:                                         if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
                   19491:                                             undef($uselink);
                   19492:                                             last;
                   19493:                                         }
                   19494:                                     }
                   19495:                                 }
                   19496:                             }
                   19497:                         }
                   19498:                     }
                   19499:                 }
                   19500:             } elsif ($xframeop ne '') {
                   19501:                 $uselink = 1;
                   19502:                 my @policies = split(/\s*,\s*/,$xframeop);
                   19503:                 if (@policies) {
                   19504:                     unless (grep(/^deny$/,@policies)) {
                   19505:                         if ($origin ne '') {
                   19506:                             if (grep(/^sameorigin$/,@policies)) {
                   19507:                                 if ($remotehost eq $origin) {
                   19508:                                     undef($uselink);
                   19509:                                 }
                   19510:                             }
                   19511:                             if ($uselink) {
                   19512:                                 foreach my $policy (@policies) {
                   19513:                                     if ($policy =~ /^allow-from\s*(.+)$/) {
                   19514:                                         my $allowfrom = $1;
                   19515:                                         if (($allowfrom ne '') && ($allowfrom eq $origin)) {
                   19516:                                             undef($uselink);
                   19517:                                             last;
                   19518:                                         }
                   19519:                                     }
                   19520:                                 }
                   19521:                             }
                   19522:                         }
                   19523:                     }
                   19524:                 }
                   19525:             }
                   19526:         }
                   19527:     }
1.1329    raeburn  19528:     if ($nocache) {
                   19529:         if ($cached) {
                   19530:             my $devalidate;
                   19531:             if ($uselink && !$result) {
                   19532:                 $devalidate = 1;
                   19533:             } elsif (!$uselink && $result) {
                   19534:                 $devalidate = 1;
                   19535:             }
                   19536:             if ($devalidate) {
                   19537:                 &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
                   19538:             }
                   19539:         }
                   19540:     } else {
                   19541:         if ($uselink) {
                   19542:             $result = 1;
                   19543:         } else {
                   19544:             $result = 0;
                   19545:         }
                   19546:         &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
                   19547:     }
1.1328    raeburn  19548:     return $uselink;
                   19549: }
                   19550: 
1.1359    raeburn  19551: sub page_menu {
                   19552:     my ($menucolls,$menunum) = @_;
                   19553:     my %menu;
                   19554:     foreach my $item (split(/;/,$menucolls)) {
                   19555:         my ($num,$value) = split(/\%/,$item);
                   19556:         if ($num eq $menunum) {
                   19557:             my @entries = split(/\&/,$value);
                   19558:             foreach my $entry (@entries) {
                   19559:                 my ($name,$fields) = split(/=/,$entry);
1.1368    raeburn  19560:                 if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359    raeburn  19561:                     $menu{$name} = $fields;
                   19562:                 } else {
                   19563:                     my @shown;
                   19564:                     if ($fields =~ /,/) {
                   19565:                         @shown = split(/,/,$fields);
                   19566:                     } else {
                   19567:                         @shown = ($fields);
                   19568:                     }
                   19569:                     if (@shown) {
                   19570:                         foreach my $field (@shown) {
                   19571:                             next if ($field eq '');
                   19572:                             $menu{$field} = 1;
                   19573:                         }
                   19574:                     }
                   19575:                 }
                   19576:             }
                   19577:         }
                   19578:     }
                   19579:     return %menu;
                   19580: }
                   19581: 
1.112     bowersj2 19582: 1;
                   19583: __END__;
1.41      ng       19584: 

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