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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1075.2.161.  .22(raeb    4:-24): # $Id: loncommon.pm,v 1.1075.2.161.2.21 2024/02/28 01:21:29 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.1075.2.161.  .7(raebu   64:22): 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.1075.2.25  raeburn    70: use Apache::lonuserutils();
1.1075.2.27  raeburn    71: use Apache::lonuserstate();
1.1075.2.69  raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.1075.2.161.  .13(raeb   74:-23): use LONCAPA::map();
1.1075.2.135  raeburn    75: use HTTP::Request;
1.657     raeburn    76: use DateTime::TimeZone;
1.1075.2.102  raeburn    77: use DateTime::Locale;
1.1075.2.94  raeburn    78: use Encode();
1.1075.2.14  raeburn    79: use Authen::Captcha;
                     80: use Captcha::reCAPTCHA;
1.1075.2.107  raeburn    81: use JSON::DWIW;
                     82: use LWP::UserAgent;
1.1075.2.64  raeburn    83: use Crypt::DES;
                     84: use DynaLoader; # for Crypt::DES version
1.1075.2.128  raeburn    85: use File::Copy();
                     86: use File::Path();
1.1075.2.161.  .1(raebu   87:21): use String::CRC32();
                     88:21): use Short::URL();
1.117     www        89: 
1.517     raeburn    90: # ---------------------------------------------- Designs
                     91: use vars qw(%defaultdesign);
                     92: 
1.22      www        93: my $readit;
                     94: 
1.517     raeburn    95: 
1.157     matthew    96: ##
                     97: ## Global Variables
                     98: ##
1.46      matthew    99: 
1.643     foxr      100: 
                    101: # ----------------------------------------------- SSI with retries:
                    102: #
                    103: 
                    104: =pod
                    105: 
1.648     raeburn   106: =head1 Server Side include with retries:
1.643     foxr      107: 
                    108: =over 4
                    109: 
1.648     raeburn   110: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      111: 
                    112: Performs an ssi with some number of retries.  Retries continue either
                    113: until the result is ok or until the retry count supplied by the
                    114: caller is exhausted.  
                    115: 
                    116: Inputs:
1.648     raeburn   117: 
                    118: =over 4
                    119: 
1.643     foxr      120: resource   - Identifies the resource to insert.
1.648     raeburn   121: 
1.643     foxr      122: retries    - Count of the number of retries allowed.
1.648     raeburn   123: 
1.643     foxr      124: form       - Hash that identifies the rendering options.
                    125: 
1.648     raeburn   126: =back
                    127: 
                    128: Returns:
                    129: 
                    130: =over 4
                    131: 
1.643     foxr      132: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   133: 
1.643     foxr      134: response   - The response from the last attempt (which may or may not have been successful.
                    135: 
1.648     raeburn   136: =back
                    137: 
                    138: =back
                    139: 
1.643     foxr      140: =cut
                    141: 
                    142: sub ssi_with_retries {
                    143:     my ($resource, $retries, %form) = @_;
                    144: 
                    145: 
                    146:     my $ok = 0;			# True if we got a good response.
                    147:     my $content;
                    148:     my $response;
                    149: 
                    150:     # Try to get the ssi done. within the retries count:
                    151: 
                    152:     do {
                    153: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    154: 	$ok      = $response->is_success;
1.650     www       155:         if (!$ok) {
                    156:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    157:         }
1.643     foxr      158: 	$retries--;
                    159:     } while (!$ok && ($retries > 0));
                    160: 
                    161:     if (!$ok) {
                    162: 	$content = '';		# On error return an empty content.
                    163:     }
                    164:     return ($content, $response);
                    165: 
                    166: }
                    167: 
                    168: 
                    169: 
1.20      www       170: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  171: my %language;
1.124     www       172: my %supported_language;
1.1048    foxr      173: my %latex_language;		# For choosing hyphenation in <transl..>
                    174: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  175: my %cprtag;
1.192     taceyjo1  176: my %scprtag;
1.351     www       177: my %fe; my %fd; my %fm;
1.41      ng        178: my %category_extensions;
1.12      harris41  179: 
1.46      matthew   180: # ---------------------------------------------- Thesaurus variables
1.144     matthew   181: #
                    182: # %Keywords:
                    183: #      A hash used by &keyword to determine if a word is considered a keyword.
                    184: # $thesaurus_db_file 
                    185: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   186: 
                    187: my %Keywords;
                    188: my $thesaurus_db_file;
                    189: 
1.144     matthew   190: #
                    191: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    192: # thesaurus.tab, and filecategories.tab.
                    193: #
1.18      www       194: BEGIN {
1.46      matthew   195:     # Variable initialization
                    196:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    197:     #
1.22      www       198:     unless ($readit) {
1.12      harris41  199: # ------------------------------------------------------------------- languages
                    200:     {
1.158     raeburn   201:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    202:                                    '/language.tab';
1.1075.2.128  raeburn   203:         if ( open(my $fh,'<',$langtabfile) ) {
1.356     albertel  204:             while (my $line = <$fh>) {
                    205:                 next if ($line=~/^\#/);
                    206:                 chomp($line);
1.1048    foxr      207:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   208:                 $language{$key}=$val.' - '.$enc;
                    209:                 if ($sup) {
                    210:                     $supported_language{$key}=$sup;
                    211:                 }
1.1048    foxr      212: 		if ($latex) {
                    213: 		    $latex_language_bykey{$key} = $latex;
                    214: 		    $latex_language{$two} = $latex;
                    215: 		}
1.158     raeburn   216:             }
                    217:             close($fh);
                    218:         }
1.12      harris41  219:     }
                    220: # ------------------------------------------------------------------ copyrights
                    221:     {
1.158     raeburn   222:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    223:                                   '/copyright.tab';
1.1075.2.128  raeburn   224:         if ( open (my $fh,'<',$copyrightfile) ) {
1.356     albertel  225:             while (my $line = <$fh>) {
                    226:                 next if ($line=~/^\#/);
                    227:                 chomp($line);
                    228:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   229:                 $cprtag{$key}=$val;
                    230:             }
                    231:             close($fh);
                    232:         }
1.12      harris41  233:     }
1.351     www       234: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  235:     {
                    236:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    237:                                   '/source_copyright.tab';
1.1075.2.128  raeburn   238:         if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356     albertel  239:             while (my $line = <$fh>) {
                    240:                 next if ($line =~ /^\#/);
                    241:                 chomp($line);
                    242:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  243:                 $scprtag{$key}=$val;
                    244:             }
                    245:             close($fh);
                    246:         }
                    247:     }
1.63      www       248: 
1.517     raeburn   249: # -------------------------------------------------------------- default domain designs
1.63      www       250:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   251:     my $designfile = $designdir.'/default.tab';
1.1075.2.128  raeburn   252:     if ( open (my $fh,'<',$designfile) ) {
1.517     raeburn   253:         while (my $line = <$fh>) {
                    254:             next if ($line =~ /^\#/);
                    255:             chomp($line);
                    256:             my ($key,$val)=(split(/\=/,$line));
                    257:             if ($val) { $defaultdesign{$key}=$val; }
                    258:         }
                    259:         close($fh);
1.63      www       260:     }
                    261: 
1.15      harris41  262: # ------------------------------------------------------------- file categories
                    263:     {
1.158     raeburn   264:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    265:                                   '/filecategories.tab';
1.1075.2.128  raeburn   266:         if ( open (my $fh,'<',$categoryfile) ) {
1.356     albertel  267: 	    while (my $line = <$fh>) {
                    268: 		next if ($line =~ /^\#/);
                    269: 		chomp($line);
                    270:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.1075.2.119  raeburn   271:                 push(@{$category_extensions{lc($category)}},$extension);
1.158     raeburn   272:             }
                    273:             close($fh);
                    274:         }
                    275: 
1.15      harris41  276:     }
1.12      harris41  277: # ------------------------------------------------------------------ file types
                    278:     {
1.158     raeburn   279:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    280:                '/filetypes.tab';
1.1075.2.128  raeburn   281:         if ( open (my $fh,'<',$typesfile) ) {
1.356     albertel  282:             while (my $line = <$fh>) {
                    283: 		next if ($line =~ /^\#/);
                    284: 		chomp($line);
                    285:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   286:                 if ($descr ne '') {
                    287:                     $fe{$ending}=lc($emb);
                    288:                     $fd{$ending}=$descr;
1.351     www       289:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   290:                 }
                    291:             }
                    292:             close($fh);
                    293:         }
1.12      harris41  294:     }
1.22      www       295:     &Apache::lonnet::logthis(
1.705     tempelho  296:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       297:     $readit=1;
1.46      matthew   298:     }  # end of unless($readit) 
1.32      matthew   299:     
                    300: }
1.112     bowersj2  301: 
1.42      matthew   302: ###############################################################
                    303: ##           HTML and Javascript Helper Functions            ##
                    304: ###############################################################
                    305: 
                    306: =pod 
                    307: 
1.112     bowersj2  308: =head1 HTML and Javascript Functions
1.42      matthew   309: 
1.112     bowersj2  310: =over 4
                    311: 
1.648     raeburn   312: =item * &browser_and_searcher_javascript()
1.112     bowersj2  313: 
                    314: X<browsing, javascript>X<searching, javascript>Returns a string
                    315: containing javascript with two functions, C<openbrowser> and
                    316: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    317: tags.
1.42      matthew   318: 
1.648     raeburn   319: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   320: 
                    321: inputs: formname, elementname, only, omit
                    322: 
                    323: formname and elementname indicate the name of the html form and name of
                    324: the element that the results of the browsing selection are to be placed in. 
                    325: 
                    326: Specifying 'only' will restrict the browser to displaying only files
1.185     www       327: with the given extension.  Can be a comma separated list.
1.42      matthew   328: 
                    329: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       330: with the given extension.  Can be a comma separated list.
1.42      matthew   331: 
1.648     raeburn   332: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   333: 
                    334: Inputs: formname, elementname
                    335: 
                    336: formname and elementname specify the name of the html form and the name
                    337: of the element the selection from the search results will be placed in.
1.542     raeburn   338: 
1.42      matthew   339: =cut
                    340: 
                    341: sub browser_and_searcher_javascript {
1.199     albertel  342:     my ($mode)=@_;
                    343:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  344:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   345:     return <<END;
1.219     albertel  346: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   347:     var editbrowser = null;
1.135     albertel  348:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       349:         var url = '$resurl/?';
1.42      matthew   350:         if (editbrowser == null) {
                    351:             url += 'launch=1&';
                    352:         }
                    353:         url += 'catalogmode=interactive&';
1.199     albertel  354:         url += 'mode=$mode&';
1.611     albertel  355:         url += 'inhibitmenu=yes&';
1.42      matthew   356:         url += 'form=' + formname + '&';
                    357:         if (only != null) {
                    358:             url += 'only=' + only + '&';
1.217     albertel  359:         } else {
                    360:             url += 'only=&';
                    361: 	}
1.42      matthew   362:         if (omit != null) {
                    363:             url += 'omit=' + omit + '&';
1.217     albertel  364:         } else {
                    365:             url += 'omit=&';
                    366: 	}
1.135     albertel  367:         if (titleelement != null) {
                    368:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  369:         } else {
                    370: 	    url += 'titleelement=&';
                    371: 	}
1.42      matthew   372:         url += 'element=' + elementname + '';
                    373:         var title = 'Browser';
1.435     albertel  374:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   375:         options += ',width=700,height=600';
                    376:         editbrowser = open(url,title,options,'1');
                    377:         editbrowser.focus();
                    378:     }
                    379:     var editsearcher;
1.135     albertel  380:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   381:         var url = '/adm/searchcat?';
                    382:         if (editsearcher == null) {
                    383:             url += 'launch=1&';
                    384:         }
                    385:         url += 'catalogmode=interactive&';
1.199     albertel  386:         url += 'mode=$mode&';
1.42      matthew   387:         url += 'form=' + formname + '&';
1.135     albertel  388:         if (titleelement != null) {
                    389:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  390:         } else {
                    391: 	    url += 'titleelement=&';
                    392: 	}
1.42      matthew   393:         url += 'element=' + elementname + '';
                    394:         var title = 'Search';
1.435     albertel  395:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   396:         options += ',width=700,height=600';
                    397:         editsearcher = open(url,title,options,'1');
                    398:         editsearcher.focus();
                    399:     }
1.219     albertel  400: // END LON-CAPA Internal -->
1.42      matthew   401: END
1.170     www       402: }
                    403: 
                    404: sub lastresurl {
1.258     albertel  405:     if ($env{'environment.lastresurl'}) {
                    406: 	return $env{'environment.lastresurl'}
1.170     www       407:     } else {
                    408: 	return '/res';
                    409:     }
                    410: }
                    411: 
                    412: sub storeresurl {
                    413:     my $resurl=&Apache::lonnet::clutter(shift);
                    414:     unless ($resurl=~/^\/res/) { return 0; }
                    415:     $resurl=~s/\/$//;
                    416:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   417:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       418:     return 1;
1.42      matthew   419: }
                    420: 
1.74      www       421: sub studentbrowser_javascript {
1.111     www       422:    unless (
1.258     albertel  423:             (($env{'request.course.id'}) && 
1.302     albertel  424:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    425: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    426: 					  '/'.$env{'request.course.sec'})
                    427: 	      ))
1.258     albertel  428:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       429:           ) { return ''; }  
1.74      www       430:    return (<<'ENDSTDBRW');
1.776     bisitz    431: <script type="text/javascript" language="Javascript">
1.824     bisitz    432: // <![CDATA[
1.74      www       433:     var stdeditbrowser;
1.1075.2.161.  .20(raeb  434:-23):     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv,uident) {
1.74      www       435:         var url = '/adm/pickstudent?';
                    436:         var filter;
1.558     albertel  437: 	if (!ignorefilter) {
                    438: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    439: 	}
1.74      www       440:         if (filter != null) {
                    441:            if (filter != '') {
                    442:                url += 'filter='+filter+'&';
                    443: 	   }
                    444:         }
                    445:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       446:                                     '&udomelement='+udom+
                    447:                                     '&clicker='+clicker;
1.111     www       448: 	if (roleflag) { url+="&roles=1"; }
1.1075.2.143  raeburn   449:         if (courseadv == 'condition') {
                    450:             if (document.getElementById('courseadv')) {
                    451:                 courseadv = document.getElementById('courseadv').value;
                    452:             }
                    453:         }
                    454:         if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.1075.2.161.  .20(raeb  455:-23):         if (uident !== '') { url+="&identelement="+uident; }
1.102     www       456:         var title = 'Student_Browser';
1.74      www       457:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    458:         options += ',width=700,height=600';
                    459:         stdeditbrowser = open(url,title,options,'1');
                    460:         stdeditbrowser.focus();
                    461:     }
1.824     bisitz    462: // ]]>
1.74      www       463: </script>
                    464: ENDSTDBRW
                    465: }
1.42      matthew   466: 
1.1003    www       467: sub resourcebrowser_javascript {
                    468:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       469:    return (<<'ENDRESBRW');
1.1003    www       470: <script type="text/javascript" language="Javascript">
                    471: // <![CDATA[
                    472:     var reseditbrowser;
1.1004    www       473:     function openresbrowser(formname,reslink) {
1.1005    www       474:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       475:         var title = 'Resource_Browser';
                    476:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       477:         options += ',width=700,height=500';
1.1004    www       478:         reseditbrowser = open(url,title,options,'1');
                    479:         reseditbrowser.focus();
1.1003    www       480:     }
                    481: // ]]>
                    482: </script>
1.1004    www       483: ENDRESBRW
1.1003    www       484: }
                    485: 
1.74      www       486: sub selectstudent_link {
1.1075.2.161.  .20(raeb  487:-23):    my ($form,$unameele,$udomele,$courseadv,$clickerid,$identelem)=@_;
1.999     www       488:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    489:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    490:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  491:    if ($env{'request.course.id'}) {  
1.302     albertel  492:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    493: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    494: 					'/'.$env{'request.course.sec'})) {
1.111     www       495: 	   return '';
                    496:        }
1.999     www       497:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1075.2.143  raeburn   498:        if ($courseadv eq 'only') {
                    499:            $callargs .= ",'',1,'$courseadv'";
                    500:        } elsif ($courseadv eq 'none') {
                    501:            $callargs .= ",'','','$courseadv'";
                    502:        } elsif ($courseadv eq 'condition') {
                    503:            $callargs .= ",'','','$courseadv'";
1.1075.2.161.  .20(raeb  504:-23):        } elsif ($identelem ne '') {
                    505:-23):            $callargs .= ",'','',''";
                    506:-23):        }
                    507:-23):        if ($identelem ne '') {
                    508:-23):            $callargs .= ",'".&Apache::lonhtmlcommon::entity_encode($identelem)."'";
1.793     raeburn   509:        }
                    510:        return '<span class="LC_nobreak">'.
                    511:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    512:               &mt('Select User').'</a></span>';
1.74      www       513:    }
1.258     albertel  514:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       515:        $callargs .= ",'',1"; 
1.793     raeburn   516:        return '<span class="LC_nobreak">'.
                    517:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    518:               &mt('Select User').'</a></span>';
1.111     www       519:    }
                    520:    return '';
1.91      www       521: }
                    522: 
1.1004    www       523: sub selectresource_link {
                    524:    my ($form,$reslink,$arg)=@_;
                    525:    
                    526:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    527:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    528:    unless ($env{'request.course.id'}) { return $arg; }
                    529:    return '<span class="LC_nobreak">'.
                    530:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    531:               $arg.'</a></span>';
                    532: }
                    533: 
                    534: 
                    535: 
1.653     raeburn   536: sub authorbrowser_javascript {
                    537:     return <<"ENDAUTHORBRW";
1.776     bisitz    538: <script type="text/javascript" language="JavaScript">
1.824     bisitz    539: // <![CDATA[
1.653     raeburn   540: var stdeditbrowser;
                    541: 
                    542: function openauthorbrowser(formname,udom) {
                    543:     var url = '/adm/pickauthor?';
                    544:     url += 'form='+formname+'&roledom='+udom;
                    545:     var title = 'Author_Browser';
                    546:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    547:     options += ',width=700,height=600';
                    548:     stdeditbrowser = open(url,title,options,'1');
                    549:     stdeditbrowser.focus();
                    550: }
                    551: 
1.824     bisitz    552: // ]]>
1.653     raeburn   553: </script>
                    554: ENDAUTHORBRW
                    555: }
                    556: 
1.91      www       557: sub coursebrowser_javascript {
1.1075.2.31  raeburn   558:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95  raeburn   559:         $credits_element,$instcode) = @_;
1.932     raeburn   560:     my $wintitle = 'Course_Browser';
1.931     raeburn   561:     if ($crstype eq 'Community') {
1.932     raeburn   562:         $wintitle = 'Community_Browser';
1.909     raeburn   563:     }
1.876     raeburn   564:     my $id_functions = &javascript_index_functions();
                    565:     my $output = '
1.776     bisitz    566: <script type="text/javascript" language="JavaScript">
1.824     bisitz    567: // <![CDATA[
1.468     raeburn   568:     var stdeditbrowser;'."\n";
1.876     raeburn   569: 
                    570:     $output .= <<"ENDSTDBRW";
1.909     raeburn   571:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       572:         var url = '/adm/pickcourse?';
1.895     raeburn   573:         var formid = getFormIdByName(formname);
1.876     raeburn   574:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  575:         if (domainfilter != null) {
                    576:            if (domainfilter != '') {
                    577:                url += 'domainfilter='+domainfilter+'&';
                    578: 	   }
                    579:         }
1.91      www       580:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  581: 	                            '&cdomelement='+udom+
                    582:                                     '&cnameelement='+desc;
1.468     raeburn   583:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   584:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   585:                 url += '&roleelement='+extra_element;
                    586:                 if (domainfilter == null || domainfilter == '') {
                    587:                     url += '&domainfilter='+extra_element;
                    588:                 }
1.234     raeburn   589:             }
1.468     raeburn   590:             else {
                    591:                 if (formname == 'portform') {
                    592:                     url += '&setroles='+extra_element;
1.800     raeburn   593:                 } else {
                    594:                     if (formname == 'rules') {
                    595:                         url += '&fixeddom='+extra_element; 
                    596:                     }
1.468     raeburn   597:                 }
                    598:             }     
1.230     raeburn   599:         }
1.909     raeburn   600:         if (type != null && type != '') {
                    601:             url += '&type='+type;
                    602:         }
                    603:         if (type_elem != null && type_elem != '') {
                    604:             url += '&typeelement='+type_elem;
                    605:         }
1.872     raeburn   606:         if (formname == 'ccrs') {
                    607:             var ownername = document.forms[formid].ccuname.value;
                    608:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101  raeburn   609:             url += '&cloner='+ownername+':'+ownerdom;
                    610:             if (type == 'Course') {
                    611:                 url += '&crscode='+document.forms[formid].crscode.value;
                    612:             }
1.1075.2.95  raeburn   613:         }
                    614:         if (formname == 'requestcrs') {
                    615:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   616:         }
1.293     raeburn   617:         if (multflag !=null && multflag != '') {
                    618:             url += '&multiple='+multflag;
                    619:         }
1.909     raeburn   620:         var title = '$wintitle';
1.91      www       621:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    622:         options += ',width=700,height=600';
                    623:         stdeditbrowser = open(url,title,options,'1');
                    624:         stdeditbrowser.focus();
                    625:     }
1.876     raeburn   626: $id_functions
                    627: ENDSTDBRW
1.1075.2.31  raeburn   628:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    629:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    630:                                       $credits_element);
1.876     raeburn   631:     }
                    632:     $output .= '
                    633: // ]]>
                    634: </script>';
                    635:     return $output;
                    636: }
                    637: 
                    638: sub javascript_index_functions {
                    639:     return <<"ENDJS";
                    640: 
                    641: function getFormIdByName(formname) {
                    642:     for (var i=0;i<document.forms.length;i++) {
                    643:         if (document.forms[i].name == formname) {
                    644:             return i;
                    645:         }
                    646:     }
                    647:     return -1;
                    648: }
                    649: 
                    650: function getIndexByName(formid,item) {
                    651:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    652:         if (document.forms[formid].elements[i].name == item) {
                    653:             return i;
                    654:         }
                    655:     }
                    656:     return -1;
                    657: }
1.468     raeburn   658: 
1.876     raeburn   659: function getDomainFromSelectbox(formname,udom) {
                    660:     var userdom;
                    661:     var formid = getFormIdByName(formname);
                    662:     if (formid > -1) {
                    663:         var domid = getIndexByName(formid,udom);
                    664:         if (domid > -1) {
                    665:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    666:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    667:             }
                    668:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    669:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   670:             }
                    671:         }
                    672:     }
1.876     raeburn   673:     return userdom;
                    674: }
                    675: 
                    676: ENDJS
1.468     raeburn   677: 
1.876     raeburn   678: }
                    679: 
1.1017    raeburn   680: sub javascript_array_indexof {
1.1018    raeburn   681:     return <<ENDJS;
1.1017    raeburn   682: <script type="text/javascript" language="JavaScript">
                    683: // <![CDATA[
                    684: 
                    685: if (!Array.prototype.indexOf) {
                    686:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    687:         "use strict";
                    688:         if (this === void 0 || this === null) {
                    689:             throw new TypeError();
                    690:         }
                    691:         var t = Object(this);
                    692:         var len = t.length >>> 0;
                    693:         if (len === 0) {
                    694:             return -1;
                    695:         }
                    696:         var n = 0;
                    697:         if (arguments.length > 0) {
                    698:             n = Number(arguments[1]);
                    699:             if (n !== n) { // shortcut for verifying if it's NaN
                    700:                 n = 0;
                    701:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    702:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    703:             }
                    704:         }
                    705:         if (n >= len) {
                    706:             return -1;
                    707:         }
                    708:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    709:         for (; k < len; k++) {
                    710:             if (k in t && t[k] === searchElement) {
                    711:                 return k;
                    712:             }
                    713:         }
                    714:         return -1;
                    715:     }
                    716: }
                    717: 
                    718: // ]]>
                    719: </script>
                    720: 
                    721: ENDJS
                    722: 
                    723: }
                    724: 
1.876     raeburn   725: sub userbrowser_javascript {
                    726:     my $id_functions = &javascript_index_functions();
                    727:     return <<"ENDUSERBRW";
                    728: 
1.888     raeburn   729: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   730:     var url = '/adm/pickuser?';
                    731:     var userdom = getDomainFromSelectbox(formname,udom);
                    732:     if (userdom != null) {
                    733:        if (userdom != '') {
                    734:            url += 'srchdom='+userdom+'&';
                    735:        }
                    736:     }
                    737:     url += 'form=' + formname + '&unameelement='+uname+
                    738:                                 '&udomelement='+udom+
                    739:                                 '&ulastelement='+ulast+
                    740:                                 '&ufirstelement='+ufirst+
                    741:                                 '&uemailelement='+uemail+
1.881     raeburn   742:                                 '&hideudomelement='+hideudom+
                    743:                                 '&coursedom='+crsdom;
1.888     raeburn   744:     if ((caller != null) && (caller != undefined)) {
                    745:         url += '&caller='+caller;
                    746:     }
1.876     raeburn   747:     var title = 'User_Browser';
                    748:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    749:     options += ',width=700,height=600';
                    750:     var stdeditbrowser = open(url,title,options,'1');
                    751:     stdeditbrowser.focus();
                    752: }
                    753: 
1.888     raeburn   754: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   755:     var formid = getFormIdByName(formname);
                    756:     if (formid > -1) {
1.888     raeburn   757:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   758:         var domid = getIndexByName(formid,udom);
                    759:         var hidedomid = getIndexByName(formid,origdom);
                    760:         if (hidedomid > -1) {
                    761:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   762:             var unameval = document.forms[formid].elements[unameid].value;
                    763:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    764:                 if (domid > -1) {
                    765:                     var slct = document.forms[formid].elements[domid];
                    766:                     if (slct.type == 'select-one') {
                    767:                         var i;
                    768:                         for (i=0;i<slct.length;i++) {
                    769:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    770:                         }
                    771:                     }
                    772:                     if (slct.type == 'hidden') {
                    773:                         slct.value = fixeddom;
1.876     raeburn   774:                     }
                    775:                 }
1.468     raeburn   776:             }
                    777:         }
                    778:     }
1.876     raeburn   779:     return;
                    780: }
                    781: 
                    782: $id_functions
                    783: ENDUSERBRW
1.468     raeburn   784: }
                    785: 
                    786: sub setsec_javascript {
1.1075.2.31  raeburn   787:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   788:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    789:         $communityrolestr);
                    790:     if ($role_element ne '') {
                    791:         my @allroles = ('st','ta','ep','in','ad');
                    792:         foreach my $crstype ('Course','Community') {
                    793:             if ($crstype eq 'Community') {
                    794:                 foreach my $role (@allroles) {
                    795:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    796:                 }
                    797:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    798:             } else {
                    799:                 foreach my $role (@allroles) {
                    800:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    801:                 }
                    802:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    803:             }
                    804:         }
                    805:         $rolestr = '"'.join('","',@allroles).'"';
                    806:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    807:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    808:     }
1.468     raeburn   809:     my $setsections = qq|
                    810: function setSect(sectionlist) {
1.629     raeburn   811:     var sectionsArray = new Array();
                    812:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    813:         sectionsArray = sectionlist.split(",");
                    814:     }
1.468     raeburn   815:     var numSections = sectionsArray.length;
                    816:     document.$formname.$sec_element.length = 0;
                    817:     if (numSections == 0) {
                    818:         document.$formname.$sec_element.multiple=false;
                    819:         document.$formname.$sec_element.size=1;
                    820:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    821:     } else {
                    822:         if (numSections == 1) {
                    823:             document.$formname.$sec_element.multiple=false;
                    824:             document.$formname.$sec_element.size=1;
                    825:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    826:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    827:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    828:         } else {
                    829:             for (var i=0; i<numSections; i++) {
                    830:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    831:             }
                    832:             document.$formname.$sec_element.multiple=true
                    833:             if (numSections < 3) {
                    834:                 document.$formname.$sec_element.size=numSections;
                    835:             } else {
                    836:                 document.$formname.$sec_element.size=3;
                    837:             }
                    838:             document.$formname.$sec_element.options[0].selected = false
                    839:         }
                    840:     }
1.91      www       841: }
1.905     raeburn   842: 
                    843: function setRole(crstype) {
1.468     raeburn   844: |;
1.905     raeburn   845:     if ($role_element eq '') {
                    846:         $setsections .= '    return;
                    847: }
                    848: ';
                    849:     } else {
                    850:         $setsections .= qq|
                    851:     var elementLength = document.$formname.$role_element.length;
                    852:     var allroles = Array($rolestr);
                    853:     var courserolenames = Array($courserolestr);
                    854:     var communityrolenames = Array($communityrolestr);
                    855:     if (elementLength != undefined) {
                    856:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    857:             if (crstype == 'Course') {
                    858:                 return;
                    859:             } else {
                    860:                 allroles[5] = 'co';
                    861:                 for (var i=0; i<6; i++) {
                    862:                     document.$formname.$role_element.options[i].value = allroles[i];
                    863:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    864:                 }
                    865:             }
                    866:         } else {
                    867:             if (crstype == 'Community') {
                    868:                 return;
                    869:             } else {
                    870:                 allroles[5] = 'cc';
                    871:                 for (var i=0; i<6; i++) {
                    872:                     document.$formname.$role_element.options[i].value = allroles[i];
                    873:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    874:                 }
                    875:             }
                    876:         }
                    877:     }
                    878:     return;
                    879: }
                    880: |;
                    881:     }
1.1075.2.31  raeburn   882:     if ($credits_element) {
                    883:         $setsections .= qq|
                    884: function setCredits(defaultcredits) {
                    885:     document.$formname.$credits_element.value = defaultcredits;
                    886:     return;
                    887: }
                    888: |;
                    889:     }
1.468     raeburn   890:     return $setsections;
                    891: }
                    892: 
1.91      www       893: sub selectcourse_link {
1.909     raeburn   894:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    895:        $typeelement) = @_;
                    896:    my $type = $selecttype;
1.871     raeburn   897:    my $linktext = &mt('Select Course');
                    898:    if ($selecttype eq 'Community') {
1.909     raeburn   899:        $linktext = &mt('Select Community');
1.906     raeburn   900:    } elsif ($selecttype eq 'Course/Community') {
                    901:        $linktext = &mt('Select Course/Community');
1.909     raeburn   902:        $type = '';
1.1019    raeburn   903:    } elsif ($selecttype eq 'Select') {
                    904:        $linktext = &mt('Select');
                    905:        $type = '';
1.871     raeburn   906:    }
1.787     bisitz    907:    return '<span class="LC_nobreak">'
                    908:          ."<a href='"
                    909:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    910:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   911:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   912:          ."'>".$linktext.'</a>'
1.787     bisitz    913:          .'</span>';
1.74      www       914: }
1.42      matthew   915: 
1.653     raeburn   916: sub selectauthor_link {
                    917:    my ($form,$udom)=@_;
                    918:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    919:           &mt('Select Author').'</a>';
                    920: }
                    921: 
1.876     raeburn   922: sub selectuser_link {
1.881     raeburn   923:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   924:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   925:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   926:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   927:            ');">'.$linktext.'</a>';
1.876     raeburn   928: }
                    929: 
1.273     raeburn   930: sub check_uncheck_jscript {
                    931:     my $jscript = <<"ENDSCRT";
                    932: function checkAll(field) {
                    933:     if (field.length > 0) {
                    934:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   935:             if (!field[i].disabled) {
                    936:                 field[i].checked = true;
                    937:             }
1.273     raeburn   938:         }
                    939:     } else {
1.1075.2.14  raeburn   940:         if (!field.disabled) {
                    941:             field.checked = true;
                    942:         }
1.273     raeburn   943:     }
                    944: }
                    945:  
                    946: function uncheckAll(field) {
                    947:     if (field.length > 0) {
                    948:         for (i = 0; i < field.length; i++) {
                    949:             field[i].checked = false ;
1.543     albertel  950:         }
                    951:     } else {
1.273     raeburn   952:         field.checked = false ;
                    953:     }
                    954: }
                    955: ENDSCRT
                    956:     return $jscript;
                    957: }
                    958: 
1.656     www       959: sub select_timezone {
1.1075.2.161.  .10(raeb  960:-22):    my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;
                    961:-22):    my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";
1.659     raeburn   962:    if ($includeempty) {
                    963:        $output .= '<option value=""';
                    964:        if (($selected eq '') || ($selected eq 'local')) {
                    965:            $output .= ' selected="selected" ';
                    966:        }
                    967:        $output .= '> </option>';
                    968:    }
1.657     raeburn   969:    my @timezones = DateTime::TimeZone->all_names;
                    970:    foreach my $tzone (@timezones) {
                    971:        $output.= '<option value="'.$tzone.'"';
                    972:        if ($tzone eq $selected) {
                    973:            $output.=' selected="selected"';
                    974:        }
                    975:        $output.=">$tzone</option>\n";
1.656     www       976:    }
                    977:    $output.="</select>";
                    978:    return $output;
                    979: }
1.273     raeburn   980: 
1.687     raeburn   981: sub select_datelocale {
1.1075.2.115  raeburn   982:     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    983:     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687     raeburn   984:     if ($includeempty) {
                    985:         $output .= '<option value=""';
                    986:         if ($selected eq '') {
                    987:             $output .= ' selected="selected" ';
                    988:         }
                    989:         $output .= '> </option>';
                    990:     }
1.1075.2.102  raeburn   991:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   992:     my (@possibles,%locale_names);
1.1075.2.102  raeburn   993:     my @locales = DateTime::Locale->ids();
                    994:     foreach my $id (@locales) {
                    995:         if ($id ne '') {
                    996:             my ($en_terr,$native_terr);
                    997:             my $loc = DateTime::Locale->load($id);
                    998:             if (ref($loc)) {
                    999:                 $en_terr = $loc->name();
                   1000:                 $native_terr = $loc->native_name();
1.687     raeburn  1001:                 if (grep(/^en$/,@languages) || !@languages) {
                   1002:                     if ($en_terr ne '') {
                   1003:                         $locale_names{$id} = '('.$en_terr.')';
                   1004:                     } elsif ($native_terr ne '') {
                   1005:                         $locale_names{$id} = $native_terr;
                   1006:                     }
                   1007:                 } else {
                   1008:                     if ($native_terr ne '') {
                   1009:                         $locale_names{$id} = $native_terr.' ';
                   1010:                     } elsif ($en_terr ne '') {
                   1011:                         $locale_names{$id} = '('.$en_terr.')';
                   1012:                     }
                   1013:                 }
1.1075.2.94  raeburn  1014:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102  raeburn  1015:                 push(@possibles,$id);
1.687     raeburn  1016:             }
                   1017:         }
                   1018:     }
                   1019:     foreach my $item (sort(@possibles)) {
                   1020:         $output.= '<option value="'.$item.'"';
                   1021:         if ($item eq $selected) {
                   1022:             $output.=' selected="selected"';
                   1023:         }
                   1024:         $output.=">$item";
                   1025:         if ($locale_names{$item} ne '') {
1.1075.2.94  raeburn  1026:             $output.='  '.$locale_names{$item};
1.687     raeburn  1027:         }
                   1028:         $output.="</option>\n";
                   1029:     }
                   1030:     $output.="</select>";
                   1031:     return $output;
                   1032: }
                   1033: 
1.792     raeburn  1034: sub select_language {
1.1075.2.115  raeburn  1035:     my ($name,$selected,$includeempty,$noedit) = @_;
1.792     raeburn  1036:     my %langchoices;
                   1037:     if ($includeempty) {
1.1075.2.32  raeburn  1038:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1039:     }
                   1040:     foreach my $id (&languageids()) {
                   1041:         my $code = &supportedlanguagecode($id);
                   1042:         if ($code) {
                   1043:             $langchoices{$code} = &plainlanguagedescription($id);
                   1044:         }
                   1045:     }
1.1075.2.32  raeburn  1046:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1075.2.115  raeburn  1047:     return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792     raeburn  1048: }
                   1049: 
1.42      matthew  1050: =pod
1.36      matthew  1051: 
1.648     raeburn  1052: =item * &linked_select_forms(...)
1.36      matthew  1053: 
                   1054: linked_select_forms returns a string containing a <script></script> block
                   1055: and html for two <select> menus.  The select menus will be linked in that
                   1056: changing the value of the first menu will result in new values being placed
                   1057: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1058: order unless a defined order is provided.
1.36      matthew  1059: 
                   1060: linked_select_forms takes the following ordered inputs:
                   1061: 
                   1062: =over 4
                   1063: 
1.112     bowersj2 1064: =item * $formname, the name of the <form> tag
1.36      matthew  1065: 
1.112     bowersj2 1066: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1067: 
1.112     bowersj2 1068: =item * $firstdefault, the default value for the first menu
1.36      matthew  1069: 
1.112     bowersj2 1070: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1071: 
1.112     bowersj2 1072: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1073: 
1.112     bowersj2 1074: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1075: 
1.609     raeburn  1076: =item * $menuorder, the order of values in the first menu
                   1077: 
1.1075.2.31  raeburn  1078: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1079:         event for the first <select> tag
                   1080: 
                   1081: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1082:         event for the second <select> tag
                   1083: 
1.41      ng       1084: =back 
                   1085: 
1.36      matthew  1086: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1087: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1088: values for the first select menu.  The text that coincides with the 
1.41      ng       1089: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1090: and text for the second menu are given in the hash pointed to by 
                   1091: $menu{$choice1}->{'select2'}.  
                   1092: 
1.112     bowersj2 1093:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1094:                        default => "B3",
                   1095:                        select2 => { 
                   1096:                            B1 => "Choice B1",
                   1097:                            B2 => "Choice B2",
                   1098:                            B3 => "Choice B3",
                   1099:                            B4 => "Choice B4"
1.609     raeburn  1100:                            },
                   1101:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1102:                    },
                   1103:                A2 => { text =>"Choice A2" ,
                   1104:                        default => "C2",
                   1105:                        select2 => { 
                   1106:                            C1 => "Choice C1",
                   1107:                            C2 => "Choice C2",
                   1108:                            C3 => "Choice C3"
1.609     raeburn  1109:                            },
                   1110:                        order => ['C2','C1','C3'],
1.112     bowersj2 1111:                    },
                   1112:                A3 => { text =>"Choice A3" ,
                   1113:                        default => "D6",
                   1114:                        select2 => { 
                   1115:                            D1 => "Choice D1",
                   1116:                            D2 => "Choice D2",
                   1117:                            D3 => "Choice D3",
                   1118:                            D4 => "Choice D4",
                   1119:                            D5 => "Choice D5",
                   1120:                            D6 => "Choice D6",
                   1121:                            D7 => "Choice D7"
1.609     raeburn  1122:                            },
                   1123:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1124:                    }
                   1125:                );
1.36      matthew  1126: 
                   1127: =cut
                   1128: 
                   1129: sub linked_select_forms {
                   1130:     my ($formname,
                   1131:         $middletext,
                   1132:         $firstdefault,
                   1133:         $firstselectname,
                   1134:         $secondselectname, 
1.609     raeburn  1135:         $hashref,
                   1136:         $menuorder,
1.1075.2.31  raeburn  1137:         $onchangefirst,
                   1138:         $onchangesecond
1.36      matthew  1139:         ) = @_;
                   1140:     my $second = "document.$formname.$secondselectname";
                   1141:     my $first = "document.$formname.$firstselectname";
                   1142:     # output the javascript to do the changing
                   1143:     my $result = '';
1.776     bisitz   1144:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1145:     $result.="// <![CDATA[\n";
1.36      matthew  1146:     $result.="var select2data = new Object();\n";
                   1147:     $" = '","';
                   1148:     my $debug = '';
                   1149:     foreach my $s1 (sort(keys(%$hashref))) {
                   1150:         $result.="select2data.d_$s1 = new Object();\n";        
                   1151:         $result.="select2data.d_$s1.def = new String('".
                   1152:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1153:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1154:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1155:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1156:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1157:         }
1.36      matthew  1158:         $result.="\"@s2values\");\n";
                   1159:         $result.="select2data.d_$s1.texts = new Array(";        
                   1160:         my @s2texts;
                   1161:         foreach my $value (@s2values) {
1.1075.2.119  raeburn  1162:             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36      matthew  1163:         }
                   1164:         $result.="\"@s2texts\");\n";
                   1165:     }
                   1166:     $"=' ';
                   1167:     $result.= <<"END";
                   1168: 
                   1169: function select1_changed() {
                   1170:     // Determine new choice
                   1171:     var newvalue = "d_" + $first.value;
                   1172:     // update select2
                   1173:     var values     = select2data[newvalue].values;
                   1174:     var texts      = select2data[newvalue].texts;
                   1175:     var select2def = select2data[newvalue].def;
                   1176:     var i;
                   1177:     // out with the old
                   1178:     for (i = 0; i < $second.options.length; i++) {
                   1179:         $second.options[i] = null;
                   1180:     }
                   1181:     // in with the nuclear
                   1182:     for (i=0;i<values.length; i++) {
                   1183:         $second.options[i] = new Option(values[i]);
1.143     matthew  1184:         $second.options[i].value = values[i];
1.36      matthew  1185:         $second.options[i].text = texts[i];
                   1186:         if (values[i] == select2def) {
                   1187:             $second.options[i].selected = true;
                   1188:         }
                   1189:     }
                   1190: }
1.824     bisitz   1191: // ]]>
1.36      matthew  1192: </script>
                   1193: END
                   1194:     # output the initial values for the selection lists
1.1075.2.31  raeburn  1195:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1196:     my @order = sort(keys(%{$hashref}));
                   1197:     if (ref($menuorder) eq 'ARRAY') {
                   1198:         @order = @{$menuorder};
                   1199:     }
                   1200:     foreach my $value (@order) {
1.36      matthew  1201:         $result.="    <option value=\"$value\" ";
1.253     albertel 1202:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1203:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1204:     }
                   1205:     $result .= "</select>\n";
                   1206:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1207:     $result .= $middletext;
1.1075.2.31  raeburn  1208:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1209:     if ($onchangesecond) {
                   1210:         $result .= ' onchange="'.$onchangesecond.'"';
                   1211:     }
                   1212:     $result .= ">\n";
1.36      matthew  1213:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1214:     
                   1215:     my @secondorder = sort(keys(%select2));
                   1216:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1217:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1218:     }
                   1219:     foreach my $value (@secondorder) {
1.36      matthew  1220:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1221:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1222:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1223:     }
                   1224:     $result .= "</select>\n";
                   1225:     #    return $debug;
                   1226:     return $result;
                   1227: }   #  end of sub linked_select_forms {
                   1228: 
1.45      matthew  1229: =pod
1.44      bowersj2 1230: 
1.1075.2.161.  .6(raebu 1231:22): =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
1.44      bowersj2 1232: 
1.112     bowersj2 1233: Returns a string corresponding to an HTML link to the given help
                   1234: $topic, where $topic corresponds to the name of a .tex file in
                   1235: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1236: spaces. 
                   1237: 
                   1238: $text will optionally be linked to the same topic, allowing you to
                   1239: link text in addition to the graphic. If you do not want to link
                   1240: text, but wish to specify one of the later parameters, pass an
                   1241: empty string. 
                   1242: 
                   1243: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1244: the link will not open a new window. If false, the link will open
                   1245: a new window using Javascript. (Default is false.) 
                   1246: 
                   1247: $width and $height are optional numerical parameters that will
                   1248: override the width and height of the popped up window, which may
1.973     raeburn  1249: be useful for certain help topics with big pictures included.
                   1250: 
                   1251: $imgid is the id of the img tag used for the help icon. This may be
                   1252: used in a javascript call to switch the image src.  See 
                   1253: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1254: 
1.1075.2.161.  .6(raebu 1255:22): $links_target will optionally be set to a target (_top, _parent or _self).
                   1256:22): 
1.44      bowersj2 1257: =cut
                   1258: 
                   1259: sub help_open_topic {
1.1075.2.161.  .6(raebu 1260:22):     my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
1.48      bowersj2 1261:     $text = "" if (not defined $text);
1.44      bowersj2 1262:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1263:     $width = 500 if (not defined $width);
1.44      bowersj2 1264:     $height = 400 if (not defined $height);
                   1265:     my $filename = $topic;
                   1266:     $filename =~ s/ /_/g;
                   1267: 
1.48      bowersj2 1268:     my $template = "";
                   1269:     my $link;
1.572     banghart 1270:     
1.159     www      1271:     $topic=~s/\W/\_/g;
1.44      bowersj2 1272: 
1.572     banghart 1273:     if (!$stayOnPage) {
1.1075.2.50  raeburn  1274:         if ($env{'browser.mobile'}) {
                   1275: 	    $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
                   1276:         } else {
                   1277:             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1278:         }
1.1037    www      1279:     } elsif ($stayOnPage eq 'popup') {
                   1280:         $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 1281:     } else {
1.48      bowersj2 1282: 	$link = "/adm/help/${filename}.hlp";
                   1283:     }
                   1284: 
                   1285:     # Add the text
1.1075.2.161.  .6(raebu 1286:22):     my $target = ' target="_top"';
                   1287:22):     if ($links_target) {
                   1288:22):         $target = ' target="'.$links_target.'"';
          .17(raeb 1289:-23):     } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                   1290:-23):              (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
          .6(raebu 1291:22):         $target = '';
                   1292:22):     }
1.755     neumanie 1293:     if ($text ne "") {	
1.763     bisitz   1294: 	$template.='<span class="LC_help_open_topic">'
1.1075.2.161.  .6(raebu 1295:22):                   .'<a'.$target.' href="'.$link.'">'
1.763     bisitz   1296:                   .$text.'</a>';
1.48      bowersj2 1297:     }
                   1298: 
1.763     bisitz   1299:     # (Always) Add the graphic
1.179     matthew  1300:     my $title = &mt('Online Help');
1.667     raeburn  1301:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1302:     if ($imgid ne '') {
                   1303:         $imgid = ' id="'.$imgid.'"';
                   1304:     }
1.1075.2.161.  .6(raebu 1305:22):     $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763     bisitz   1306:               .'<img src="'.$helpicon.'" border="0"'
                   1307:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1308:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1309:               .' /></a>';
                   1310:     if ($text ne "") {	
                   1311:         $template.='</span>';
                   1312:     }
1.44      bowersj2 1313:     return $template;
                   1314: 
1.106     bowersj2 1315: }
                   1316: 
                   1317: # This is a quicky function for Latex cheatsheet editing, since it 
                   1318: # appears in at least four places
                   1319: sub helpLatexCheatsheet {
1.1037    www      1320:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1321:     my $out;
1.106     bowersj2 1322:     my $addOther = '';
1.732     raeburn  1323:     if ($topic) {
1.1037    www      1324: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1325:     }
                   1326:     $out = '<span>' # Start cheatsheet
                   1327: 	  .$addOther
                   1328:           .'<span>'
1.1037    www      1329: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1330: 	  .'</span> <span>'
1.1037    www      1331: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1332: 	  .'</span>';
1.732     raeburn  1333:     unless ($not_author) {
1.763     bisitz   1334:         $out .= ' <span>'
1.1037    www      1335: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1336: 	       .'</span> <span>'
1.1075.2.78  raeburn  1337:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1338:                .'</span>';
1.732     raeburn  1339:     }
1.763     bisitz   1340:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1341:     return $out;
1.172     www      1342: }
                   1343: 
1.430     albertel 1344: sub general_help {
                   1345:     my $helptopic='Student_Intro';
                   1346:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1347: 	$helptopic='Authoring_Intro';
1.907     raeburn  1348:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1349: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1350:     } elsif ($env{'request.role'}=~/^dc/) {
                   1351:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1352:     }
                   1353:     return $helptopic;
                   1354: }
                   1355: 
                   1356: sub update_help_link {
                   1357:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1358:     my $origurl = $ENV{'REQUEST_URI'};
                   1359:     $origurl=~s|^/~|/priv/|;
                   1360:     my $timestamp = time;
                   1361:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1362:         $$datum = &escape($$datum);
                   1363:     }
                   1364: 
                   1365:     my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
                   1366:     my $output .= <<"ENDOUTPUT";
                   1367: <script type="text/javascript">
1.824     bisitz   1368: // <![CDATA[
1.430     albertel 1369: banner_link = '$banner_link';
1.824     bisitz   1370: // ]]>
1.430     albertel 1371: </script>
                   1372: ENDOUTPUT
                   1373:     return $output;
                   1374: }
                   1375: 
                   1376: # now just updates the help link and generates a blue icon
1.193     raeburn  1377: sub help_open_menu {
1.1075.2.161.  .6(raebu 1378:22):     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target) 
1.552     banghart 1379: 	= @_;    
1.949     droeschl 1380:     $stayOnPage = 1;
1.430     albertel 1381:     my $output;
                   1382:     if ($component_help) {
                   1383: 	if (!$text) {
                   1384: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
1.1075.2.161.  .6(raebu 1385:22): 				       $width,$height,'',$links_target);
1.430     albertel 1386: 	} else {
                   1387: 	    my $help_text;
                   1388: 	    $help_text=&unescape($topic);
                   1389: 	    $output='<table><tr><td>'.
                   1390: 		&help_open_topic($component_help,$help_text,$stayOnPage,
1.1075.2.161.  .6(raebu 1391:22): 				 $width,$height,'',$links_target).'</td></tr></table>';
1.430     albertel 1392: 	}
                   1393:     }
                   1394:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1395:     return $output.$banner_link;
                   1396: }
                   1397: 
                   1398: sub top_nav_help {
1.1075.2.158  raeburn  1399:     my ($text,$linkattr) = @_;
1.436     albertel 1400:     $text = &mt($text);
1.1075.2.60  raeburn  1401:     my $stay_on_page;
                   1402:     unless ($env{'environment.remote'} eq 'on') {
                   1403:         $stay_on_page = 1;
                   1404:     }
1.1075.2.61  raeburn  1405:     my ($link,$banner_link);
                   1406:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1407:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1408: 	                         : "javascript:helpMenu('open')";
                   1409:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1410:     }
1.201     raeburn  1411:     my $title = &mt('Get help');
1.1075.2.61  raeburn  1412:     if ($link) {
                   1413:         return <<"END";
1.436     albertel 1414: $banner_link
1.1075.2.158  raeburn  1415: <a href="$link" title="$title" $linkattr>$text</a>
1.436     albertel 1416: END
1.1075.2.61  raeburn  1417:     } else {
                   1418:         return '&nbsp;'.$text.'&nbsp;';
                   1419:     }
1.436     albertel 1420: }
                   1421: 
                   1422: sub help_menu_js {
1.1075.2.52  raeburn  1423:     my ($httphost) = @_;
1.949     droeschl 1424:     my $stayOnPage = 1;
1.436     albertel 1425:     my $width = 620;
                   1426:     my $height = 600;
1.430     albertel 1427:     my $helptopic=&general_help();
1.1075.2.52  raeburn  1428:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1429:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1430:     my $start_page =
                   1431:         &Apache::loncommon::start_page('Help Menu', undef,
                   1432: 				       {'frameset'    => 1,
                   1433: 					'js_ready'    => 1,
1.1075.2.136  raeburn  1434:                                         'use_absolute' => $httphost,
1.331     albertel 1435: 					'add_entries' => {
                   1436: 					    'border' => '0',
1.579     raeburn  1437: 					    'rows'   => "110,*",},});
1.331     albertel 1438:     my $end_page =
                   1439:         &Apache::loncommon::end_page({'frameset' => 1,
                   1440: 				      'js_ready' => 1,});
                   1441: 
1.436     albertel 1442:     my $template .= <<"ENDTEMPLATE";
                   1443: <script type="text/javascript">
1.877     bisitz   1444: // <![CDATA[
1.253     albertel 1445: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1446: var banner_link = '';
1.243     raeburn  1447: function helpMenu(target) {
                   1448:     var caller = this;
                   1449:     if (target == 'open') {
                   1450:         var newWindow = null;
                   1451:         try {
1.262     albertel 1452:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1453:         }
                   1454:         catch(error) {
                   1455:             writeHelp(caller);
                   1456:             return;
                   1457:         }
                   1458:         if (newWindow) {
                   1459:             caller = newWindow;
                   1460:         }
1.193     raeburn  1461:     }
1.243     raeburn  1462:     writeHelp(caller);
                   1463:     return;
                   1464: }
                   1465: function writeHelp(caller) {
1.1075.2.61  raeburn  1466:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1467:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1468:     caller.document.close();
                   1469:     caller.focus();
1.193     raeburn  1470: }
1.877     bisitz   1471: // END LON-CAPA Internal -->
1.253     albertel 1472: // ]]>
1.436     albertel 1473: </script>
1.193     raeburn  1474: ENDTEMPLATE
                   1475:     return $template;
                   1476: }
                   1477: 
1.172     www      1478: sub help_open_bug {
                   1479:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1480:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1481:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1482:     $text = "" if (not defined $text);
                   1483: 	$stayOnPage=1;
1.184     albertel 1484:     $width = 600 if (not defined $width);
                   1485:     $height = 600 if (not defined $height);
1.172     www      1486: 
                   1487:     $topic=~s/\W+/\+/g;
                   1488:     my $link='';
                   1489:     my $template='';
1.379     albertel 1490:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1491: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1492:     if (!$stayOnPage)
                   1493:     {
                   1494: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1495:     }
                   1496:     else
                   1497:     {
                   1498: 	$link = $url;
                   1499:     }
1.1075.2.161.  .6(raebu 1500:22): 
                   1501:22):     my $target = '_top';
                   1502:22):     if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                   1503:22):         (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
                   1504:22):         $target = '_blank';
                   1505:22):     }
                   1506:22): 
1.172     www      1507:     # Add the text
                   1508:     if ($text ne "")
                   1509:     {
                   1510: 	$template .= 
                   1511:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1075.2.161.  .6(raebu 1512:22):   "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1513:     }
                   1514: 
                   1515:     # Add the graphic
1.179     matthew  1516:     my $title = &mt('Report a Bug');
1.215     albertel 1517:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1518:     $template .= <<"ENDTEMPLATE";
1.1075.2.161.  .6(raebu 1519:22):  <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1520: ENDTEMPLATE
                   1521:     if ($text ne '') { $template.='</td></tr></table>' };
                   1522:     return $template;
                   1523: 
                   1524: }
                   1525: 
                   1526: sub help_open_faq {
                   1527:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1528:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1529:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1530:     $text = "" if (not defined $text);
                   1531: 	$stayOnPage=1;
                   1532:     $width = 350 if (not defined $width);
                   1533:     $height = 400 if (not defined $height);
                   1534: 
                   1535:     $topic=~s/\W+/\+/g;
                   1536:     my $link='';
                   1537:     my $template='';
                   1538:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1539:     if (!$stayOnPage)
                   1540:     {
                   1541: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1542:     }
                   1543:     else
                   1544:     {
                   1545: 	$link = $url;
                   1546:     }
                   1547: 
                   1548:     # Add the text
                   1549:     if ($text ne "")
                   1550:     {
                   1551: 	$template .= 
1.173     www      1552:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1553:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1554:     }
                   1555: 
                   1556:     # Add the graphic
1.179     matthew  1557:     my $title = &mt('View the FAQ');
1.215     albertel 1558:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1559:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1560:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1561: ENDTEMPLATE
                   1562:     if ($text ne '') { $template.='</td></tr></table>' };
                   1563:     return $template;
                   1564: 
1.44      bowersj2 1565: }
1.37      matthew  1566: 
1.180     matthew  1567: ###############################################################
                   1568: ###############################################################
                   1569: 
1.45      matthew  1570: =pod
                   1571: 
1.648     raeburn  1572: =item * &change_content_javascript():
1.256     matthew  1573: 
                   1574: This and the next function allow you to create small sections of an
                   1575: otherwise static HTML page that you can update on the fly with
                   1576: Javascript, even in Netscape 4.
                   1577: 
                   1578: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1579: must be written to the HTML page once. It will prove the Javascript
                   1580: function "change(name, content)". Calling the change function with the
                   1581: name of the section 
                   1582: you want to update, matching the name passed to C<changable_area>, and
                   1583: the new content you want to put in there, will put the content into
                   1584: that area.
                   1585: 
                   1586: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1587: to contain room for the original contents. You need to "make space"
                   1588: for whatever changes you wish to make, and be B<sure> to check your
                   1589: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1590: it's adequate for updating a one-line status display, but little more.
                   1591: This script will set the space to 100% width, so you only need to
                   1592: worry about height in Netscape 4.
                   1593: 
                   1594: Modern browsers are much less limiting, and if you can commit to the
                   1595: user not using Netscape 4, this feature may be used freely with
                   1596: pretty much any HTML.
                   1597: 
                   1598: =cut
                   1599: 
                   1600: sub change_content_javascript {
                   1601:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1602:     if ($env{'browser.type'} eq 'netscape' &&
                   1603: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1604: 	return (<<NETSCAPE4);
                   1605: 	function change(name, content) {
                   1606: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1607: 	    doc.open();
                   1608: 	    doc.write(content);
                   1609: 	    doc.close();
                   1610: 	}
                   1611: NETSCAPE4
                   1612:     } else {
                   1613: 	# Otherwise, we need to use semi-standards-compliant code
                   1614: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1615: 	# is really scary, and every useful browser supports it
                   1616: 	return (<<DOMBASED);
                   1617: 	function change(name, content) {
                   1618: 	    element = document.getElementById(name);
                   1619: 	    element.innerHTML = content;
                   1620: 	}
                   1621: DOMBASED
                   1622:     }
                   1623: }
                   1624: 
                   1625: =pod
                   1626: 
1.648     raeburn  1627: =item * &changable_area($name,$origContent):
1.256     matthew  1628: 
                   1629: This provides a "changable area" that can be modified on the fly via
                   1630: the Javascript code provided in C<change_content_javascript>. $name is
                   1631: the name you will use to reference the area later; do not repeat the
                   1632: same name on a given HTML page more then once. $origContent is what
                   1633: the area will originally contain, which can be left blank.
                   1634: 
                   1635: =cut
                   1636: 
                   1637: sub changable_area {
                   1638:     my ($name, $origContent) = @_;
                   1639: 
1.258     albertel 1640:     if ($env{'browser.type'} eq 'netscape' &&
                   1641: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1642: 	# If this is netscape 4, we need to use the Layer tag
                   1643: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1644:     } else {
                   1645: 	return "<span id='$name'>$origContent</span>";
                   1646:     }
                   1647: }
                   1648: 
                   1649: =pod
                   1650: 
1.648     raeburn  1651: =item * &viewport_geometry_js 
1.590     raeburn  1652: 
                   1653: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1654: 
                   1655: =cut
                   1656: 
                   1657: 
                   1658: sub viewport_geometry_js { 
                   1659:     return <<"GEOMETRY";
                   1660: var Geometry = {};
                   1661: function init_geometry() {
                   1662:     if (Geometry.init) { return };
                   1663:     Geometry.init=1;
                   1664:     if (window.innerHeight) {
                   1665:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1666:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1667:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1668:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1669:     }
                   1670:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1671:         Geometry.getViewportHeight =
                   1672:             function() { return document.documentElement.clientHeight; };
                   1673:         Geometry.getViewportWidth =
                   1674:             function() { return document.documentElement.clientWidth; };
                   1675: 
                   1676:         Geometry.getHorizontalScroll =
                   1677:             function() { return document.documentElement.scrollLeft; };
                   1678:         Geometry.getVerticalScroll =
                   1679:             function() { return document.documentElement.scrollTop; };
                   1680:     }
                   1681:     else if (document.body.clientHeight) {
                   1682:         Geometry.getViewportHeight =
                   1683:             function() { return document.body.clientHeight; };
                   1684:         Geometry.getViewportWidth =
                   1685:             function() { return document.body.clientWidth; };
                   1686:         Geometry.getHorizontalScroll =
                   1687:             function() { return document.body.scrollLeft; };
                   1688:         Geometry.getVerticalScroll =
                   1689:             function() { return document.body.scrollTop; };
                   1690:     }
                   1691: }
                   1692: 
                   1693: GEOMETRY
                   1694: }
                   1695: 
                   1696: =pod
                   1697: 
1.648     raeburn  1698: =item * &viewport_size_js()
1.590     raeburn  1699: 
                   1700: 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. 
                   1701: 
                   1702: =cut
                   1703: 
                   1704: sub viewport_size_js {
                   1705:     my $geometry = &viewport_geometry_js();
                   1706:     return <<"DIMS";
                   1707: 
                   1708: $geometry
                   1709: 
                   1710: function getViewportDims(width,height) {
                   1711:     init_geometry();
                   1712:     width.value = Geometry.getViewportWidth();
                   1713:     height.value = Geometry.getViewportHeight();
                   1714:     return;
                   1715: }
                   1716: 
                   1717: DIMS
                   1718: }
                   1719: 
                   1720: =pod
                   1721: 
1.648     raeburn  1722: =item * &resize_textarea_js()
1.565     albertel 1723: 
                   1724: emits the needed javascript to resize a textarea to be as big as possible
                   1725: 
                   1726: creates a function resize_textrea that takes two IDs first should be
                   1727: the id of the element to resize, second should be the id of a div that
                   1728: surrounds everything that comes after the textarea, this routine needs
                   1729: to be attached to the <body> for the onload and onresize events.
                   1730: 
                   1731: =cut
                   1732: 
                   1733: sub resize_textarea_js {
1.590     raeburn  1734:     my $geometry = &viewport_geometry_js();
1.565     albertel 1735:     return <<"RESIZE";
                   1736:     <script type="text/javascript">
1.824     bisitz   1737: // <![CDATA[
1.590     raeburn  1738: $geometry
1.565     albertel 1739: 
1.588     albertel 1740: function getX(element) {
                   1741:     var x = 0;
                   1742:     while (element) {
                   1743: 	x += element.offsetLeft;
                   1744: 	element = element.offsetParent;
                   1745:     }
                   1746:     return x;
                   1747: }
                   1748: function getY(element) {
                   1749:     var y = 0;
                   1750:     while (element) {
                   1751: 	y += element.offsetTop;
                   1752: 	element = element.offsetParent;
                   1753:     }
                   1754:     return y;
                   1755: }
                   1756: 
                   1757: 
1.565     albertel 1758: function resize_textarea(textarea_id,bottom_id) {
                   1759:     init_geometry();
                   1760:     var textarea        = document.getElementById(textarea_id);
                   1761:     //alert(textarea);
                   1762: 
1.588     albertel 1763:     var textarea_top    = getY(textarea);
1.565     albertel 1764:     var textarea_height = textarea.offsetHeight;
                   1765:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1766:     var bottom_top      = getY(bottom);
1.565     albertel 1767:     var bottom_height   = bottom.offsetHeight;
                   1768:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1769:     var fudge           = 23;
1.565     albertel 1770:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1771:     if (new_height < 300) {
                   1772: 	new_height = 300;
                   1773:     }
                   1774:     textarea.style.height=new_height+'px';
                   1775: }
1.824     bisitz   1776: // ]]>
1.565     albertel 1777: </script>
                   1778: RESIZE
                   1779: 
                   1780: }
                   1781: 
1.1075.2.112  raeburn  1782: sub colorfuleditor_js {
                   1783:     return <<"COLORFULEDIT"
                   1784: <script type="text/javascript">
                   1785: // <![CDATA[>
                   1786:     function fold_box(curDepth, lastresource){
                   1787: 
                   1788:     // we need a list because there can be several blocks you need to fold in one tag
                   1789:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1790:     // but there is only one folding button per tag
                   1791:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1792: 
                   1793:         if(block.item(0).style.display == 'none'){
                   1794: 
                   1795:             foldbutton.value = '@{[&mt("Hide")]}';
                   1796:             for (i = 0; i < block.length; i++){
                   1797:                 block.item(i).style.display = '';
                   1798:             }
                   1799:         }else{
                   1800: 
                   1801:             foldbutton.value = '@{[&mt("Show")]}';
                   1802:             for (i = 0; i < block.length; i++){
                   1803:                 // block.item(i).style.visibility = 'collapse';
                   1804:                 block.item(i).style.display = 'none';
                   1805:             }
                   1806:         };
                   1807:         saveState(lastresource);
                   1808:     }
                   1809: 
                   1810:     function saveState (lastresource) {
                   1811: 
                   1812:         var tag_list = getTagList();
                   1813:         if(tag_list != null){
                   1814:             var timestamp = new Date().getTime();
                   1815:             var key = lastresource;
                   1816: 
                   1817:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1818:             // starting with timestamp
                   1819:             var value = timestamp+';';
                   1820: 
                   1821:             // building the list of key-value pairs
                   1822:             for(var i = 0; i < tag_list.length; i++){
                   1823:                 value += tag_list[i]+',';
                   1824:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1825:             }
                   1826: 
                   1827:             // only iterate whole storage if nothing to override
                   1828:             if(localStorage.getItem(key) == null){
                   1829: 
                   1830:                 // prevent storage from growing large
                   1831:                 if(localStorage.length > 50){
                   1832:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1833:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1834:                     var oldest_key;
                   1835: 
                   1836:                     for(var i = 1; i < localStorage.length; i++){
                   1837:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1838:                             oldest_key = localStorage.key(i);
                   1839:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1840:                         }
                   1841:                     }
                   1842:                     localStorage.removeItem(oldest_key);
                   1843:                 }
                   1844:             }
                   1845:             localStorage.setItem(key,value);
                   1846:         }
                   1847:     }
                   1848: 
                   1849:     // restore folding status of blocks (on page load)
                   1850:     function restoreState (lastresource) {
                   1851:         if(localStorage.getItem(lastresource) != null){
                   1852:             var key = lastresource;
                   1853:             var value = localStorage.getItem(key);
                   1854:             var regex_delTimestamp = /^\d+;/;
                   1855: 
                   1856:             value.replace(regex_delTimestamp, '');
                   1857: 
                   1858:             var valueArr = value.split(';');
                   1859:             var pairs;
                   1860:             var elements;
                   1861:             for (var i = 0; i < valueArr.length; i++){
                   1862:                 pairs = valueArr[i].split(',');
                   1863:                 elements = document.getElementsByName(pairs[0]);
                   1864: 
                   1865:                 for (var j = 0; j < elements.length; j++){
                   1866:                     elements[j].style.display = pairs[1];
                   1867:                     if (pairs[1] == "none"){
                   1868:                         var regex_id = /([_\\d]+)\$/;
                   1869:                         regex_id.exec(pairs[0]);
                   1870:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   1871:                     }
                   1872:                 }
                   1873:             }
                   1874:         }
                   1875:     }
                   1876: 
                   1877:     function getTagList () {
                   1878: 
                   1879:         var stringToSearch = document.lonhomework.innerHTML;
                   1880: 
                   1881:         var ret = new Array();
                   1882:         var regex_findBlock = /(foldblock_.*?)"/g;
                   1883:         var tag_list = stringToSearch.match(regex_findBlock);
                   1884: 
                   1885:         if(tag_list != null){
                   1886:             for(var i = 0; i < tag_list.length; i++){
                   1887:                 ret.push(tag_list[i].replace(/"/, ''));
                   1888:             }
                   1889:         }
                   1890:         return ret;
                   1891:     }
                   1892: 
                   1893:     function saveScrollPosition (resource) {
                   1894:         var tag_list = getTagList();
                   1895: 
                   1896:         // we dont always want to jump to the first block
                   1897:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   1898:         if(\$(window).scrollTop() > 170){
                   1899:             if(tag_list != null){
                   1900:                 var result;
                   1901:                 for(var i = 0; i < tag_list.length; i++){
                   1902:                     if(isElementInViewport(tag_list[i])){
                   1903:                         result += tag_list[i]+';';
                   1904:                     }
                   1905:                 }
                   1906:                 sessionStorage.setItem('anchor_'+resource, result);
                   1907:             }
                   1908:         } else {
                   1909:             // we dont need to save zero, just delete the item to leave everything tidy
                   1910:             sessionStorage.removeItem('anchor_'+resource);
                   1911:         }
                   1912:     }
                   1913: 
                   1914:     function restoreScrollPosition(resource){
                   1915: 
                   1916:         var elem = sessionStorage.getItem('anchor_'+resource);
                   1917:         if(elem != null){
                   1918:             var tag_list = elem.split(';');
                   1919:             var elem_list;
                   1920: 
                   1921:             for(var i = 0; i < tag_list.length; i++){
                   1922:                 elem_list = document.getElementsByName(tag_list[i]);
                   1923: 
                   1924:                 if(elem_list.length > 0){
                   1925:                     elem = elem_list[0];
                   1926:                     break;
                   1927:                 }
                   1928:             }
                   1929:             elem.scrollIntoView();
                   1930:         }
                   1931:     }
                   1932: 
                   1933:     function isElementInViewport(el) {
                   1934: 
                   1935:         // change to last element instead of first
                   1936:         var elem = document.getElementsByName(el);
                   1937:         var rect = elem[0].getBoundingClientRect();
                   1938: 
                   1939:         return (
                   1940:             rect.top >= 0 &&
                   1941:             rect.left >= 0 &&
                   1942:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   1943:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   1944:         );
                   1945:     }
                   1946: 
                   1947:     function autosize(depth){
                   1948:         var cmInst = window['cm'+depth];
                   1949:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   1950: 
                   1951:         // is fixed size, switching to dynamic
                   1952:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   1953:             cmInst.setSize("","auto");
                   1954:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   1955:             sessionStorage.setItem("autosized_"+depth, "yes");
                   1956: 
                   1957:         // is dynamic size, switching to fixed
                   1958:         } else {
                   1959:             cmInst.setSize("","300px");
                   1960:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   1961:             sessionStorage.removeItem("autosized_"+depth);
                   1962:         }
                   1963:     }
                   1964: 
                   1965: 
                   1966: 
                   1967: // ]]>
                   1968: </script>
                   1969: COLORFULEDIT
                   1970: }
                   1971: 
                   1972: sub xmleditor_js {
                   1973:     return <<XMLEDIT
                   1974: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   1975: <script type="text/javascript">
                   1976: // <![CDATA[>
                   1977: 
                   1978:     function saveScrollPosition (resource) {
                   1979: 
                   1980:         var scrollPos = \$(window).scrollTop();
                   1981:         sessionStorage.setItem(resource,scrollPos);
                   1982:     }
                   1983: 
                   1984:     function restoreScrollPosition(resource){
                   1985: 
                   1986:         var scrollPos = sessionStorage.getItem(resource);
                   1987:         \$(window).scrollTop(scrollPos);
                   1988:     }
                   1989: 
                   1990:     // unless internet explorer
                   1991:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   1992: 
                   1993:         \$(document).ready(function() {
                   1994:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   1995:         });
                   1996:     }
                   1997: 
                   1998:     // inserts text at cursor position into codemirror (xml editor only)
                   1999:     function insertText(text){
                   2000:         cm.focus();
                   2001:         var curPos = cm.getCursor();
                   2002:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   2003:     }
                   2004: // ]]>
                   2005: </script>
                   2006: XMLEDIT
                   2007: }
                   2008: 
                   2009: sub insert_folding_button {
                   2010:     my $curDepth = $Apache::lonxml::curdepth;
                   2011:     my $lastresource = $env{'request.ambiguous'};
                   2012: 
                   2013:     return "<input type=\"button\" id=\"folding_btn_$curDepth\"
                   2014:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2015: }
                   2016: 
1.1075.2.161.  .21(raeb 2017:-24): =pod
                   2018:-24): 
                   2019:-24): =item * &iframe_wrapper_headjs()
                   2020:-24): 
                   2021:-24): emits javascript containing two global vars to facilitate handling of resizing
                   2022:-24): by code in iframe_wrapper_resizejs() used when an iframe is present in a page
                   2023:-24): with standard LON-CAPA menus.
                   2024:-24): 
                   2025:-24): =cut
                   2026:-24): 
                   2027:-24): #
                   2028:-24): # Where iframe is in use, if window.onload() executes before the custom resize function
                   2029:-24): # has been defined (jQuery), two global javascript vars (LCnotready and LCresizedef)
                   2030:-24): # are used to ensure document.ready() triggers a call to resize, so the iframe contents
                   2031:-24): # do not obscure the Functions menu.
                   2032:-24): #
                   2033:-24): 
                   2034:-24): sub iframe_wrapper_headjs {
                   2035:-24):     return <<"ENDJS";
                   2036:-24): <script type="text/javascript">
                   2037:-24): // <![CDATA[
                   2038:-24): var LCnotready = 0;
                   2039:-24): var LCresizedef = 0;
                   2040:-24): // ]]>
                   2041:-24): </script>
                   2042:-24): 
                   2043:-24): ENDJS
                   2044:-24): 
                   2045:-24): }
                   2046:-24): 
                   2047:-24): =pod
                   2048:-24): 
                   2049:-24): =item * &iframe_wrapper_resizejs()
                   2050:-24): 
                   2051:-24): emits javascript used to handle resizing for a page containing
                   2052:-24): an iframe, to ensure that the iframe does not obscure any
                   2053:-24): standard LON-CAPA menu items.
                   2054:-24): 
                   2055:-24): =back
                   2056:-24): 
                   2057:-24): =cut
                   2058:-24): 
                   2059:-24): #
                   2060:-24): # jQuery to use when iframe is in use and a page resize occurs.
                   2061:-24): # This script will ensure that the iframe does not obscure any
                   2062:-24): # standard LON-CAPA inline menus (primary, secondary, and/or
                   2063:-24): # breadcrumbs and Functions menus. Expects javascript from
                   2064:-24): # &iframe_wrapper_headjs() to be in head portion of the web page,
                   2065:-24): # e.g., by inclusion in second arg passed to &start_page().
                   2066:-24): #
                   2067:-24): 
                   2068:-24): sub iframe_wrapper_resizejs {
                   2069:-24):     my $offset = 5;
                   2070:-24):     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']);
                   2071:-24):     if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) {
                   2072:-24):         $offset = 0;
                   2073:-24):     }
                   2074:-24):     return &Apache::lonhtmlcommon::scripttag(<<SCRIPT);
                   2075:-24):     \$(document).ready( function() {
                   2076:-24):         \$(window).unbind('resize').resize(function(){
                   2077:-24):             var header = null;
                   2078:-24):             var offset = $offset;
                   2079:-24):             var height = 0;
                   2080:-24):             var hdrtop = 0;
                   2081:-24):             if (\$('div.LC_menus_content:first').length) {
                   2082:-24):                 if (\$('div.LC_menus_content:first').hasClass ("shown")) {
                   2083:-24):                     header = \$('div.LC_menus_content:first');
                   2084:-24):                     offset = 12;
                   2085:-24):                 }
                   2086:-24):             } else if (\$('div.LC_head_subbox:first').length) {
                   2087:-24):                 header = \$('div.LC_head_subbox:first');
                   2088:-24):                 offset = 9;
                   2089:-24):             } else {
                   2090:-24):                 if (\$('#LC_breadcrumbs').length) {
                   2091:-24):                     header = \$('#LC_breadcrumbs');
                   2092:-24):                 }
                   2093:-24):             }
                   2094:-24):             if (header != null && header.length) {
                   2095:-24):                 height = header.height();
                   2096:-24):                 hdrtop = header.position().top;
                   2097:-24):             }
                   2098:-24):             var pos = height + hdrtop + offset;
                   2099:-24):             \$('.LC_iframecontainer').css('top', pos);
                   2100:-24):         });
                   2101:-24):         LCresizedef = 1;
                   2102:-24):         if (LCnotready == 1) {
                   2103:-24):             LCnotready = 0;
                   2104:-24):             \$(window).trigger('resize');
                   2105:-24):         }
                   2106:-24):     });
                   2107:-24):     window.onload = function(){
                   2108:-24):          if (LCresizedef) {
                   2109:-24):              LCnotready = 0;
                   2110:-24):              \$(window).trigger('resize');
                   2111:-24):          } else {
                   2112:-24):              LCnotready = 1;
                   2113:-24):          }
                   2114:-24):     };
                   2115:-24): SCRIPT
                   2116:-24): 
                   2117:-24): }
1.1075.2.112  raeburn  2118: 
1.565     albertel 2119: =pod
                   2120: 
1.256     matthew  2121: =head1 Excel and CSV file utility routines
                   2122: 
                   2123: =cut
                   2124: 
                   2125: ###############################################################
                   2126: ###############################################################
                   2127: 
                   2128: =pod
                   2129: 
1.1075.2.56  raeburn  2130: =over 4
                   2131: 
1.648     raeburn  2132: =item * &csv_translate($text) 
1.37      matthew  2133: 
1.185     www      2134: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2135: format.
                   2136: 
                   2137: =cut
                   2138: 
1.180     matthew  2139: ###############################################################
                   2140: ###############################################################
1.37      matthew  2141: sub csv_translate {
                   2142:     my $text = shift;
                   2143:     $text =~ s/\"/\"\"/g;
1.209     albertel 2144:     $text =~ s/\n/ /g;
1.37      matthew  2145:     return $text;
                   2146: }
1.180     matthew  2147: 
                   2148: ###############################################################
                   2149: ###############################################################
                   2150: 
                   2151: =pod
                   2152: 
1.648     raeburn  2153: =item * &define_excel_formats()
1.180     matthew  2154: 
                   2155: Define some commonly used Excel cell formats.
                   2156: 
                   2157: Currently supported formats:
                   2158: 
                   2159: =over 4
                   2160: 
                   2161: =item header
                   2162: 
                   2163: =item bold
                   2164: 
                   2165: =item h1
                   2166: 
                   2167: =item h2
                   2168: 
                   2169: =item h3
                   2170: 
1.256     matthew  2171: =item h4
                   2172: 
                   2173: =item i
                   2174: 
1.180     matthew  2175: =item date
                   2176: 
                   2177: =back
                   2178: 
                   2179: Inputs: $workbook
                   2180: 
                   2181: Returns: $format, a hash reference.
                   2182: 
1.1057    foxr     2183: 
1.180     matthew  2184: =cut
                   2185: 
                   2186: ###############################################################
                   2187: ###############################################################
                   2188: sub define_excel_formats {
                   2189:     my ($workbook) = @_;
                   2190:     my $format;
                   2191:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2192:                                                 bottom    => 1,
                   2193:                                                 align     => 'center');
                   2194:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2195:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2196:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2197:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2198:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2199:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2200:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2201:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2202:     return $format;
                   2203: }
                   2204: 
                   2205: ###############################################################
                   2206: ###############################################################
1.113     bowersj2 2207: 
                   2208: =pod
                   2209: 
1.648     raeburn  2210: =item * &create_workbook()
1.255     matthew  2211: 
                   2212: Create an Excel worksheet.  If it fails, output message on the
                   2213: request object and return undefs.
                   2214: 
                   2215: Inputs: Apache request object
                   2216: 
                   2217: Returns (undef) on failure, 
                   2218:     Excel worksheet object, scalar with filename, and formats 
                   2219:     from &Apache::loncommon::define_excel_formats on success
                   2220: 
                   2221: =cut
                   2222: 
                   2223: ###############################################################
                   2224: ###############################################################
                   2225: sub create_workbook {
                   2226:     my ($r) = @_;
                   2227:         #
                   2228:     # Create the excel spreadsheet
                   2229:     my $filename = '/prtspool/'.
1.258     albertel 2230:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2231:         time.'_'.rand(1000000000).'.xls';
                   2232:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2233:     if (! defined($workbook)) {
                   2234:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2235:         $r->print(
                   2236:             '<p class="LC_error">'
                   2237:            .&mt('Problems occurred in creating the new Excel file.')
                   2238:            .' '.&mt('This error has been logged.')
                   2239:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2240:            .'</p>'
                   2241:         );
1.255     matthew  2242:         return (undef);
                   2243:     }
                   2244:     #
1.1014    foxr     2245:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2246:     #
                   2247:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2248:     return ($workbook,$filename,$format);
                   2249: }
                   2250: 
                   2251: ###############################################################
                   2252: ###############################################################
                   2253: 
                   2254: =pod
                   2255: 
1.648     raeburn  2256: =item * &create_text_file()
1.113     bowersj2 2257: 
1.542     raeburn  2258: Create a file to write to and eventually make available to the user.
1.256     matthew  2259: If file creation fails, outputs an error message on the request object and 
                   2260: return undefs.
1.113     bowersj2 2261: 
1.256     matthew  2262: Inputs: Apache request object, and file suffix
1.113     bowersj2 2263: 
1.256     matthew  2264: Returns (undef) on failure, 
                   2265:     Filehandle and filename on success.
1.113     bowersj2 2266: 
                   2267: =cut
                   2268: 
1.256     matthew  2269: ###############################################################
                   2270: ###############################################################
                   2271: sub create_text_file {
                   2272:     my ($r,$suffix) = @_;
                   2273:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2274:     my $fh;
                   2275:     my $filename = '/prtspool/'.
1.258     albertel 2276:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2277:         time.'_'.rand(1000000000).'.'.$suffix;
                   2278:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2279:     if (! defined($fh)) {
                   2280:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2281:         $r->print(
                   2282:             '<p class="LC_error">'
                   2283:            .&mt('Problems occurred in creating the output file.')
                   2284:            .' '.&mt('This error has been logged.')
                   2285:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2286:            .'</p>'
                   2287:         );
1.113     bowersj2 2288:     }
1.256     matthew  2289:     return ($fh,$filename)
1.113     bowersj2 2290: }
                   2291: 
                   2292: 
1.256     matthew  2293: =pod 
1.113     bowersj2 2294: 
                   2295: =back
                   2296: 
                   2297: =cut
1.37      matthew  2298: 
                   2299: ###############################################################
1.33      matthew  2300: ##        Home server <option> list generating code          ##
                   2301: ###############################################################
1.35      matthew  2302: 
1.169     www      2303: # ------------------------------------------
                   2304: 
                   2305: sub domain_select {
                   2306:     my ($name,$value,$multiple)=@_;
                   2307:     my %domains=map { 
1.514     albertel 2308: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 2309:     } &Apache::lonnet::all_domains();
1.169     www      2310:     if ($multiple) {
                   2311: 	$domains{''}=&mt('Any domain');
1.550     albertel 2312: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2313: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2314:     } else {
1.550     albertel 2315: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2316: 	return &select_form($name,$value,\%domains);
1.169     www      2317:     }
                   2318: }
                   2319: 
1.282     albertel 2320: #-------------------------------------------
                   2321: 
                   2322: =pod
                   2323: 
1.519     raeburn  2324: =head1 Routines for form select boxes
                   2325: 
                   2326: =over 4
                   2327: 
1.648     raeburn  2328: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2329: 
                   2330: Returns a string containing a <select> element int multiple mode
                   2331: 
                   2332: 
                   2333: Args:
                   2334:   $name - name of the <select> element
1.506     raeburn  2335:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2336:   $size - number of rows long the select element is
1.283     albertel 2337:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2338:           (shown text should already have been &mt())
1.506     raeburn  2339:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2340: 
1.282     albertel 2341: =cut
                   2342: 
                   2343: #-------------------------------------------
1.169     www      2344: sub multiple_select_form {
1.284     albertel 2345:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2346:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2347:     my $output='';
1.191     matthew  2348:     if (! defined($size)) {
                   2349:         $size = 4;
1.283     albertel 2350:         if (scalar(keys(%$hash))<4) {
                   2351:             $size = scalar(keys(%$hash));
1.191     matthew  2352:         }
                   2353:     }
1.734     bisitz   2354:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2355:     my @order;
1.506     raeburn  2356:     if (ref($order) eq 'ARRAY')  {
                   2357:         @order = @{$order};
                   2358:     } else {
                   2359:         @order = sort(keys(%$hash));
1.501     banghart 2360:     }
                   2361:     if (exists($$hash{'select_form_order'})) {
                   2362:         @order = @{$$hash{'select_form_order'}};
                   2363:     }
                   2364:         
1.284     albertel 2365:     foreach my $key (@order) {
1.356     albertel 2366:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2367:         $output.='selected="selected" ' if ($selected{$key});
                   2368:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2369:     }
                   2370:     $output.="</select>\n";
                   2371:     return $output;
                   2372: }
                   2373: 
1.88      www      2374: #-------------------------------------------
                   2375: 
                   2376: =pod
                   2377: 
1.1075.2.115  raeburn  2378: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88      www      2379: 
                   2380: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2381: allow a user to select options from a ref to a hash containing:
                   2382: option_name => displayed text. An optional $onchange can include
1.1075.2.115  raeburn  2383: a javascript onchange item, e.g., onchange="this.form.submit();".
                   2384: An optional arg -- $readonly -- if true will cause the select form
                   2385: to be disabled, e.g., for the case where an instructor has a section-
                   2386: specific role, and is viewing/modifying parameters.  
1.970     raeburn  2387: 
1.88      www      2388: See lonrights.pm for an example invocation and use.
                   2389: 
                   2390: =cut
                   2391: 
                   2392: #-------------------------------------------
                   2393: sub select_form {
1.1075.2.115  raeburn  2394:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2395:     return unless (ref($hashref) eq 'HASH');
                   2396:     if ($onchange) {
                   2397:         $onchange = ' onchange="'.$onchange.'"';
                   2398:     }
1.1075.2.129  raeburn  2399:     my $disabled;
                   2400:     if ($readonly) {
                   2401:         $disabled = ' disabled="disabled"';
                   2402:     }
                   2403:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2404:     my @keys;
1.970     raeburn  2405:     if (exists($hashref->{'select_form_order'})) {
                   2406: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2407:     } else {
1.970     raeburn  2408: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2409:     }
1.356     albertel 2410:     foreach my $key (@keys) {
                   2411:         $selectform.=
                   2412: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2413:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2414:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2415:     }
                   2416:     $selectform.="</select>";
                   2417:     return $selectform;
                   2418: }
                   2419: 
1.475     www      2420: # For display filters
                   2421: 
                   2422: sub display_filter {
1.1074    raeburn  2423:     my ($context) = @_;
1.475     www      2424:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2425:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2426:     my $phraseinput = 'hidden';
                   2427:     my $includeinput = 'hidden';
                   2428:     my ($checked,$includetypestext);
                   2429:     if ($env{'form.displayfilter'} eq 'containing') {
                   2430:         $phraseinput = 'text'; 
                   2431:         if ($context eq 'parmslog') {
                   2432:             $includeinput = 'checkbox';
                   2433:             if ($env{'form.includetypes'}) {
                   2434:                 $checked = ' checked="checked"';
                   2435:             }
                   2436:             $includetypestext = &mt('Include parameter types');
                   2437:         }
                   2438:     } else {
                   2439:         $includetypestext = '&nbsp;';
                   2440:     }
                   2441:     my ($additional,$secondid,$thirdid);
                   2442:     if ($context eq 'parmslog') {
                   2443:         $additional = 
                   2444:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2445:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2446:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2447:             '</label>';
                   2448:         $secondid = 'includetypes';
                   2449:         $thirdid = 'includetypestext';
                   2450:     }
                   2451:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2452:                                                     '$secondid','$thirdid')";
                   2453:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2454: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2455: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2456: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2457:            &mt('Filter: [_1]',
1.477     www      2458: 	   &select_form($env{'form.displayfilter'},
                   2459: 			'displayfilter',
1.970     raeburn  2460: 			{'currentfolder' => 'Current folder/page',
1.477     www      2461: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2462: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2463: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2464:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2465:                          '" />'.$additional;
                   2466: }
                   2467: 
                   2468: sub display_filter_js {
                   2469:     my $includetext = &mt('Include parameter types');
                   2470:     return <<"ENDJS";
                   2471:   
                   2472: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2473:     var firstType = 'hidden';
                   2474:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2475:         firstType = 'text';
                   2476:     }
                   2477:     firstObject = document.getElementById(firstid);
                   2478:     if (typeof(firstObject) == 'object') {
                   2479:         if (firstObject.type != firstType) {
                   2480:             changeInputType(firstObject,firstType);
                   2481:         }
                   2482:     }
                   2483:     if (context == 'parmslog') {
                   2484:         var secondType = 'hidden';
                   2485:         if (firstType == 'text') {
                   2486:             secondType = 'checkbox';
                   2487:         }
                   2488:         secondObject = document.getElementById(secondid);  
                   2489:         if (typeof(secondObject) == 'object') {
                   2490:             if (secondObject.type != secondType) {
                   2491:                 changeInputType(secondObject,secondType);
                   2492:             }
                   2493:         }
                   2494:         var textItem = document.getElementById(thirdid);
                   2495:         var currtext = textItem.innerHTML;
                   2496:         var newtext;
                   2497:         if (firstType == 'text') {
                   2498:             newtext = '$includetext';
                   2499:         } else {
                   2500:             newtext = '&nbsp;';
                   2501:         }
                   2502:         if (currtext != newtext) {
                   2503:             textItem.innerHTML = newtext;
                   2504:         }
                   2505:     }
                   2506:     return;
                   2507: }
                   2508: 
                   2509: function changeInputType(oldObject,newType) {
                   2510:     var newObject = document.createElement('input');
                   2511:     newObject.type = newType;
                   2512:     if (oldObject.size) {
                   2513:         newObject.size = oldObject.size;
                   2514:     }
                   2515:     if (oldObject.value) {
                   2516:         newObject.value = oldObject.value;
                   2517:     }
                   2518:     if (oldObject.name) {
                   2519:         newObject.name = oldObject.name;
                   2520:     }
                   2521:     if (oldObject.id) {
                   2522:         newObject.id = oldObject.id;
                   2523:     }
                   2524:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2525:     return;
                   2526: }
                   2527: 
                   2528: ENDJS
1.475     www      2529: }
                   2530: 
1.167     www      2531: sub gradeleveldescription {
                   2532:     my $gradelevel=shift;
                   2533:     my %gradelevels=(0 => 'Not specified',
                   2534: 		     1 => 'Grade 1',
                   2535: 		     2 => 'Grade 2',
                   2536: 		     3 => 'Grade 3',
                   2537: 		     4 => 'Grade 4',
                   2538: 		     5 => 'Grade 5',
                   2539: 		     6 => 'Grade 6',
                   2540: 		     7 => 'Grade 7',
                   2541: 		     8 => 'Grade 8',
                   2542: 		     9 => 'Grade 9',
                   2543: 		     10 => 'Grade 10',
                   2544: 		     11 => 'Grade 11',
                   2545: 		     12 => 'Grade 12',
                   2546: 		     13 => 'Grade 13',
                   2547: 		     14 => '100 Level',
                   2548: 		     15 => '200 Level',
                   2549: 		     16 => '300 Level',
                   2550: 		     17 => '400 Level',
                   2551: 		     18 => 'Graduate Level');
                   2552:     return &mt($gradelevels{$gradelevel});
                   2553: }
                   2554: 
1.163     www      2555: sub select_level_form {
                   2556:     my ($deflevel,$name)=@_;
                   2557:     unless ($deflevel) { $deflevel=0; }
1.167     www      2558:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2559:     for (my $i=0; $i<=18; $i++) {
                   2560:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2561:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2562:                 ">".&gradeleveldescription($i)."</option>\n";
                   2563:     }
                   2564:     $selectform.="</select>";
                   2565:     return $selectform;
1.163     www      2566: }
1.167     www      2567: 
1.35      matthew  2568: #-------------------------------------------
                   2569: 
1.45      matthew  2570: =pod
                   2571: 
1.1075.2.115  raeburn  2572: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35      matthew  2573: 
                   2574: Returns a string containing a <select name='$name' size='1'> form to 
                   2575: allow a user to select the domain to preform an operation in.  
                   2576: See loncreateuser.pm for an example invocation and use.
                   2577: 
1.90      www      2578: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2579: selected");
                   2580: 
1.743     raeburn  2581: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2582: 
1.910     raeburn  2583: 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.
                   2584: 
1.1075.2.36  raeburn  2585: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2586: 
1.1075.2.115  raeburn  2587: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
                   2588: 
                   2589: The optional $disabled argument, if true, adds the disabled attribute to the select tag. 
1.563     raeburn  2590: 
1.35      matthew  2591: =cut
                   2592: 
                   2593: #-------------------------------------------
1.34      matthew  2594: sub select_dom_form {
1.1075.2.115  raeburn  2595:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872     raeburn  2596:     if ($onchange) {
1.874     raeburn  2597:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2598:     }
1.1075.2.115  raeburn  2599:     if ($disabled) {
                   2600:         $disabled = ' disabled="disabled"';
                   2601:     }
1.1075.2.36  raeburn  2602:     my (@domains,%exclude);
1.910     raeburn  2603:     if (ref($incdoms) eq 'ARRAY') {
                   2604:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2605:     } else {
                   2606:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2607:     }
1.90      www      2608:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2609:     if (ref($excdoms) eq 'ARRAY') {
                   2610:         map { $exclude{$_} = 1; } @{$excdoms};
                   2611:     }
1.1075.2.115  raeburn  2612:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356     albertel 2613:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2614:         next if ($exclude{$dom});
1.356     albertel 2615:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2616:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2617:         if ($showdomdesc) {
                   2618:             if ($dom ne '') {
                   2619:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2620:                 if ($domdesc ne '') {
                   2621:                     $selectdomain .= ' ('.$domdesc.')';
                   2622:                 }
                   2623:             } 
                   2624:         }
                   2625:         $selectdomain .= "</option>\n";
1.34      matthew  2626:     }
                   2627:     $selectdomain.="</select>";
                   2628:     return $selectdomain;
                   2629: }
                   2630: 
1.35      matthew  2631: #-------------------------------------------
                   2632: 
1.45      matthew  2633: =pod
                   2634: 
1.648     raeburn  2635: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2636: 
1.586     raeburn  2637: input: 4 arguments (two required, two optional) - 
                   2638:     $domain - domain of new user
                   2639:     $name - name of form element
                   2640:     $default - Value of 'default' causes a default item to be first 
                   2641:                             option, and selected by default. 
                   2642:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2643:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2644: output: returns 2 items: 
1.586     raeburn  2645: (a) form element which contains either:
                   2646:    (i) <select name="$name">
                   2647:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2648:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2649:        </select>
                   2650:        form item if there are multiple library servers in $domain, or
                   2651:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2652:        if there is only one library server in $domain.
                   2653: 
                   2654: (b) number of library servers found.
                   2655: 
                   2656: See loncreateuser.pm for example of use.
1.35      matthew  2657: 
                   2658: =cut
                   2659: 
                   2660: #-------------------------------------------
1.586     raeburn  2661: sub home_server_form_item {
                   2662:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2663:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2664:     my $result;
                   2665:     my $numlib = keys(%servers);
                   2666:     if ($numlib > 1) {
                   2667:         $result .= '<select name="'.$name.'" />'."\n";
                   2668:         if ($default) {
1.804     bisitz   2669:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2670:                        '</option>'."\n";
                   2671:         }
                   2672:         foreach my $hostid (sort(keys(%servers))) {
                   2673:             $result.= '<option value="'.$hostid.'">'.
                   2674: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2675:         }
                   2676:         $result .= '</select>'."\n";
                   2677:     } elsif ($numlib == 1) {
                   2678:         my $hostid;
                   2679:         foreach my $item (keys(%servers)) {
                   2680:             $hostid = $item;
                   2681:         }
                   2682:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2683:                    $hostid.'" />';
                   2684:                    if (!$hide) {
                   2685:                        $result .= $hostid.' '.$servers{$hostid};
                   2686:                    }
                   2687:                    $result .= "\n";
                   2688:     } elsif ($default) {
                   2689:         $result .= '<input type="hidden" name="'.$name.
                   2690:                    '" value="default" />';
                   2691:                    if (!$hide) {
                   2692:                        $result .= &mt('default');
                   2693:                    }
                   2694:                    $result .= "\n";
1.33      matthew  2695:     }
1.586     raeburn  2696:     return ($result,$numlib);
1.33      matthew  2697: }
1.112     bowersj2 2698: 
                   2699: =pod
                   2700: 
1.534     albertel 2701: =back 
                   2702: 
1.112     bowersj2 2703: =cut
1.87      matthew  2704: 
                   2705: ###############################################################
1.112     bowersj2 2706: ##                  Decoding User Agent                      ##
1.87      matthew  2707: ###############################################################
                   2708: 
                   2709: =pod
                   2710: 
1.112     bowersj2 2711: =head1 Decoding the User Agent
                   2712: 
                   2713: =over 4
                   2714: 
                   2715: =item * &decode_user_agent()
1.87      matthew  2716: 
                   2717: Inputs: $r
                   2718: 
                   2719: Outputs:
                   2720: 
                   2721: =over 4
                   2722: 
1.112     bowersj2 2723: =item * $httpbrowser
1.87      matthew  2724: 
1.112     bowersj2 2725: =item * $clientbrowser
1.87      matthew  2726: 
1.112     bowersj2 2727: =item * $clientversion
1.87      matthew  2728: 
1.112     bowersj2 2729: =item * $clientmathml
1.87      matthew  2730: 
1.112     bowersj2 2731: =item * $clientunicode
1.87      matthew  2732: 
1.112     bowersj2 2733: =item * $clientos
1.87      matthew  2734: 
1.1075.2.42  raeburn  2735: =item * $clientmobile
                   2736: 
                   2737: =item * $clientinfo
                   2738: 
1.1075.2.77  raeburn  2739: =item * $clientosversion
                   2740: 
1.87      matthew  2741: =back
                   2742: 
1.157     matthew  2743: =back 
                   2744: 
1.87      matthew  2745: =cut
                   2746: 
                   2747: ###############################################################
                   2748: ###############################################################
                   2749: sub decode_user_agent {
1.247     albertel 2750:     my ($r)=@_;
1.87      matthew  2751:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2752:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2753:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2754:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2755:     my $clientbrowser='unknown';
                   2756:     my $clientversion='0';
                   2757:     my $clientmathml='';
                   2758:     my $clientunicode='0';
1.1075.2.42  raeburn  2759:     my $clientmobile=0;
1.1075.2.77  raeburn  2760:     my $clientosversion='';
1.87      matthew  2761:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76  raeburn  2762:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2763: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2764: 	    $clientbrowser=$bname;
                   2765:             $httpbrowser=~/$vreg/i;
                   2766: 	    $clientversion=$1;
                   2767:             $clientmathml=($clientversion>=$minv);
                   2768:             $clientunicode=($clientversion>=$univ);
                   2769: 	}
                   2770:     }
                   2771:     my $clientos='unknown';
1.1075.2.42  raeburn  2772:     my $clientinfo;
1.87      matthew  2773:     if (($httpbrowser=~/linux/i) ||
                   2774:         ($httpbrowser=~/unix/i) ||
                   2775:         ($httpbrowser=~/ux/i) ||
                   2776:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2777:     if (($httpbrowser=~/vax/i) ||
                   2778:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2779:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2780:     if (($httpbrowser=~/mac/i) ||
                   2781:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77  raeburn  2782:     if ($httpbrowser=~/win/i) {
                   2783:         $clientos='win';
                   2784:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2785:             $clientosversion = $1;
                   2786:         }
                   2787:     }
1.87      matthew  2788:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2789:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2790:         $clientmobile=lc($1);
                   2791:     }
                   2792:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2793:         $clientinfo = 'firefox-'.$1;
                   2794:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2795:         $clientinfo = 'chromeframe-'.$1;
                   2796:     }
1.87      matthew  2797:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77  raeburn  2798:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2799:             $clientosversion);
1.87      matthew  2800: }
                   2801: 
1.32      matthew  2802: ###############################################################
                   2803: ##    Authentication changing form generation subroutines    ##
                   2804: ###############################################################
                   2805: ##
                   2806: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2807: ## hash, and have reasonable default values.
                   2808: ##
                   2809: ##    formname = the name given in the <form> tag.
1.35      matthew  2810: #-------------------------------------------
                   2811: 
1.45      matthew  2812: =pod
                   2813: 
1.112     bowersj2 2814: =head1 Authentication Routines
                   2815: 
                   2816: =over 4
                   2817: 
1.648     raeburn  2818: =item * &authform_xxxxxx()
1.35      matthew  2819: 
                   2820: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2821: handle some of the conveniences required for authentication forms.  
                   2822: This is not an optimal method, but it works.  
                   2823: 
                   2824: =over 4
                   2825: 
1.112     bowersj2 2826: =item * authform_header
1.35      matthew  2827: 
1.112     bowersj2 2828: =item * authform_authorwarning
1.35      matthew  2829: 
1.112     bowersj2 2830: =item * authform_nochange
1.35      matthew  2831: 
1.112     bowersj2 2832: =item * authform_kerberos
1.35      matthew  2833: 
1.112     bowersj2 2834: =item * authform_internal
1.35      matthew  2835: 
1.112     bowersj2 2836: =item * authform_filesystem
1.35      matthew  2837: 
1.1075.2.161.  .17(raeb 2838:-23): =item * authform_lti
                   2839:-23): 
1.35      matthew  2840: =back
                   2841: 
1.648     raeburn  2842: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2843: 
1.35      matthew  2844: =cut
                   2845: 
                   2846: #-------------------------------------------
1.32      matthew  2847: sub authform_header{  
                   2848:     my %in = (
                   2849:         formname => 'cu',
1.80      albertel 2850:         kerb_def_dom => '',
1.32      matthew  2851:         @_,
                   2852:     );
                   2853:     $in{'formname'} = 'document.' . $in{'formname'};
                   2854:     my $result='';
1.80      albertel 2855: 
                   2856: #---------------------------------------------- Code for upper case translation
                   2857:     my $Javascript_toUpperCase;
                   2858:     unless ($in{kerb_def_dom}) {
                   2859:         $Javascript_toUpperCase =<<"END";
                   2860:         switch (choice) {
                   2861:            case 'krb': currentform.elements[choicearg].value =
                   2862:                currentform.elements[choicearg].value.toUpperCase();
                   2863:                break;
                   2864:            default:
                   2865:         }
                   2866: END
                   2867:     } else {
                   2868:         $Javascript_toUpperCase = "";
                   2869:     }
                   2870: 
1.165     raeburn  2871:     my $radioval = "'nochange'";
1.591     raeburn  2872:     if (defined($in{'curr_authtype'})) {
                   2873:         if ($in{'curr_authtype'} ne '') {
                   2874:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2875:         }
1.174     matthew  2876:     }
1.165     raeburn  2877:     my $argfield = 'null';
1.591     raeburn  2878:     if (defined($in{'mode'})) {
1.165     raeburn  2879:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2880:             if (defined($in{'curr_autharg'})) {
                   2881:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2882:                     $argfield = "'$in{'curr_autharg'}'";
                   2883:                 }
                   2884:             }
                   2885:         }
                   2886:     }
                   2887: 
1.32      matthew  2888:     $result.=<<"END";
                   2889: var current = new Object();
1.165     raeburn  2890: current.radiovalue = $radioval;
                   2891: current.argfield = $argfield;
1.32      matthew  2892: 
                   2893: function changed_radio(choice,currentform) {
                   2894:     var choicearg = choice + 'arg';
                   2895:     // If a radio button in changed, we need to change the argfield
                   2896:     if (current.radiovalue != choice) {
                   2897:         current.radiovalue = choice;
                   2898:         if (current.argfield != null) {
                   2899:             currentform.elements[current.argfield].value = '';
                   2900:         }
                   2901:         if (choice == 'nochange') {
                   2902:             current.argfield = null;
                   2903:         } else {
                   2904:             current.argfield = choicearg;
                   2905:             switch(choice) {
                   2906:                 case 'krb': 
                   2907:                     currentform.elements[current.argfield].value = 
                   2908:                         "$in{'kerb_def_dom'}";
                   2909:                 break;
                   2910:               default:
                   2911:                 break;
                   2912:             }
                   2913:         }
                   2914:     }
                   2915:     return;
                   2916: }
1.22      www      2917: 
1.32      matthew  2918: function changed_text(choice,currentform) {
                   2919:     var choicearg = choice + 'arg';
                   2920:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2921:         $Javascript_toUpperCase
1.32      matthew  2922:         // clear old field
                   2923:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2924:             currentform.elements[current.argfield].value = '';
                   2925:         }
                   2926:         current.argfield = choicearg;
                   2927:     }
                   2928:     set_auth_radio_buttons(choice,currentform);
                   2929:     return;
1.20      www      2930: }
1.32      matthew  2931: 
                   2932: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2933:     var numauthchoices = currentform.login.length;
                   2934:     if (typeof numauthchoices  == "undefined") {
                   2935:         return;
                   2936:     } 
1.32      matthew  2937:     var i=0;
1.986     raeburn  2938:     while (i < numauthchoices) {
1.32      matthew  2939:         if (currentform.login[i].value == newvalue) { break; }
                   2940:         i++;
                   2941:     }
1.986     raeburn  2942:     if (i == numauthchoices) {
1.32      matthew  2943:         return;
                   2944:     }
                   2945:     current.radiovalue = newvalue;
                   2946:     currentform.login[i].checked = true;
                   2947:     return;
                   2948: }
                   2949: END
                   2950:     return $result;
                   2951: }
                   2952: 
1.1075.2.20  raeburn  2953: sub authform_authorwarning {
1.32      matthew  2954:     my $result='';
1.144     matthew  2955:     $result='<i>'.
                   2956:         &mt('As a general rule, only authors or co-authors should be '.
                   2957:             'filesystem authenticated '.
                   2958:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2959:     return $result;
                   2960: }
                   2961: 
1.1075.2.20  raeburn  2962: sub authform_nochange {
1.32      matthew  2963:     my %in = (
                   2964:               formname => 'document.cu',
                   2965:               kerb_def_dom => 'MSU.EDU',
                   2966:               @_,
                   2967:           );
1.1075.2.20  raeburn  2968:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2969:     my $result;
1.1075.2.20  raeburn  2970:     if (!$authnum) {
                   2971:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2972:     } else {
                   2973:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2974:                   '<input type="radio" name="login" value="nochange" '.
                   2975:                   'checked="checked" onclick="'.
1.281     albertel 2976:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2977: 	    '</label>';
1.586     raeburn  2978:     }
1.32      matthew  2979:     return $result;
                   2980: }
                   2981: 
1.591     raeburn  2982: sub authform_kerberos {
1.32      matthew  2983:     my %in = (
                   2984:               formname => 'document.cu',
                   2985:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2986:               kerb_def_auth => 'krb4',
1.32      matthew  2987:               @_,
                   2988:               );
1.586     raeburn  2989:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1075.2.117  raeburn  2990:         $autharg,$jscall,$disabled);
1.1075.2.20  raeburn  2991:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2992:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2993:        $check5 = ' checked="checked"';
1.80      albertel 2994:     } else {
1.772     bisitz   2995:        $check4 = ' checked="checked"';
1.80      albertel 2996:     }
1.1075.2.117  raeburn  2997:     if ($in{'readonly'}) {
                   2998:         $disabled = ' disabled="disabled"';
                   2999:     }
1.165     raeburn  3000:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  3001:     if (defined($in{'curr_authtype'})) {
                   3002:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   3003:             $krbcheck = ' checked="checked"';
1.623     raeburn  3004:             if (defined($in{'mode'})) {
                   3005:                 if ($in{'mode'} eq 'modifyuser') {
                   3006:                     $krbcheck = '';
                   3007:                 }
                   3008:             }
1.591     raeburn  3009:             if (defined($in{'curr_kerb_ver'})) {
                   3010:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   3011:                     $check5 = ' checked="checked"';
1.591     raeburn  3012:                     $check4 = '';
                   3013:                 } else {
1.772     bisitz   3014:                     $check4 = ' checked="checked"';
1.591     raeburn  3015:                     $check5 = '';
                   3016:                 }
1.586     raeburn  3017:             }
1.591     raeburn  3018:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  3019:                 $krbarg = $in{'curr_autharg'};
                   3020:             }
1.586     raeburn  3021:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  3022:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3023:                     $result = 
                   3024:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   3025:         $in{'curr_autharg'},$krbver);
                   3026:                 } else {
                   3027:                     $result =
                   3028:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   3029:                 }
                   3030:                 return $result; 
                   3031:             }
                   3032:         }
                   3033:     } else {
                   3034:         if ($authnum == 1) {
1.784     bisitz   3035:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  3036:         }
                   3037:     }
1.586     raeburn  3038:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   3039:         return;
1.587     raeburn  3040:     } elsif ($authtype eq '') {
1.591     raeburn  3041:         if (defined($in{'mode'})) {
1.587     raeburn  3042:             if ($in{'mode'} eq 'modifycourse') {
                   3043:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3044:                     $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587     raeburn  3045:                 }
                   3046:             }
                   3047:         }
1.586     raeburn  3048:     }
                   3049:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   3050:     if ($authtype eq '') {
                   3051:         $authtype = '<input type="radio" name="login" value="krb" '.
                   3052:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1075.2.117  raeburn  3053:                     $krbcheck.$disabled.' />';
1.586     raeburn  3054:     }
                   3055:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  3056:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  3057:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  3058:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  3059:          $in{'curr_authtype'} eq 'krb4')) {
                   3060:         $result .= &mt
1.144     matthew  3061:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 3062:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  3063:          '<label>'.$authtype,
1.281     albertel 3064:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  3065:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  3066:              'onchange="'.$jscall.'"'.$disabled.' />',
                   3067:          '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
                   3068:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281     albertel 3069: 	 '</label>');
1.586     raeburn  3070:     } elsif ($can_assign{'krb4'}) {
                   3071:         $result .= &mt
                   3072:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3073:          '[_3] Version 4 [_4]',
                   3074:          '<label>'.$authtype,
                   3075:          '</label><input type="text" size="10" name="krbarg" '.
                   3076:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  3077:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3078:          '<label><input type="hidden" name="krbver" value="4" />',
                   3079:          '</label>');
                   3080:     } elsif ($can_assign{'krb5'}) {
                   3081:         $result .= &mt
                   3082:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3083:          '[_3] Version 5 [_4]',
                   3084:          '<label>'.$authtype,
                   3085:          '</label><input type="text" size="10" name="krbarg" '.
                   3086:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  3087:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3088:          '<label><input type="hidden" name="krbver" value="5" />',
                   3089:          '</label>');
                   3090:     }
1.32      matthew  3091:     return $result;
                   3092: }
                   3093: 
1.1075.2.20  raeburn  3094: sub authform_internal {
1.586     raeburn  3095:     my %in = (
1.32      matthew  3096:                 formname => 'document.cu',
                   3097:                 kerb_def_dom => 'MSU.EDU',
                   3098:                 @_,
                   3099:                 );
1.1075.2.117  raeburn  3100:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  3101:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  3102:     if ($in{'readonly'}) {
                   3103:         $disabled = ' disabled="disabled"';
                   3104:     }
1.591     raeburn  3105:     if (defined($in{'curr_authtype'})) {
                   3106:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  3107:             if ($can_assign{'int'}) {
1.772     bisitz   3108:                 $intcheck = 'checked="checked" ';
1.623     raeburn  3109:                 if (defined($in{'mode'})) {
                   3110:                     if ($in{'mode'} eq 'modifyuser') {
                   3111:                         $intcheck = '';
                   3112:                     }
                   3113:                 }
1.591     raeburn  3114:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3115:                     $intarg = $in{'curr_autharg'};
                   3116:                 }
                   3117:             } else {
                   3118:                 $result = &mt('Currently internally authenticated.');
                   3119:                 return $result;
1.165     raeburn  3120:             }
                   3121:         }
1.586     raeburn  3122:     } else {
                   3123:         if ($authnum == 1) {
1.784     bisitz   3124:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  3125:         }
                   3126:     }
                   3127:     if (!$can_assign{'int'}) {
                   3128:         return;
1.587     raeburn  3129:     } elsif ($authtype eq '') {
1.591     raeburn  3130:         if (defined($in{'mode'})) {
1.587     raeburn  3131:             if ($in{'mode'} eq 'modifycourse') {
                   3132:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3133:                     $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587     raeburn  3134:                 }
                   3135:             }
                   3136:         }
1.165     raeburn  3137:     }
1.586     raeburn  3138:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3139:     if ($authtype eq '') {
                   3140:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1075.2.117  raeburn  3141:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3142:     }
1.605     bisitz   3143:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1075.2.117  raeburn  3144:                $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3145:     $result = &mt
1.144     matthew  3146:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3147:          '<label>'.$authtype,'</label>'.$autharg);
1.1075.2.118  raeburn  3148:     $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  3149:     return $result;
                   3150: }
                   3151: 
1.1075.2.20  raeburn  3152: sub authform_local {
1.32      matthew  3153:     my %in = (
                   3154:               formname => 'document.cu',
                   3155:               kerb_def_dom => 'MSU.EDU',
                   3156:               @_,
                   3157:               );
1.1075.2.117  raeburn  3158:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  3159:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  3160:     if ($in{'readonly'}) {
                   3161:         $disabled = ' disabled="disabled"';
                   3162:     }
1.591     raeburn  3163:     if (defined($in{'curr_authtype'})) {
                   3164:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3165:             if ($can_assign{'loc'}) {
1.772     bisitz   3166:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3167:                 if (defined($in{'mode'})) {
                   3168:                     if ($in{'mode'} eq 'modifyuser') {
                   3169:                         $loccheck = '';
                   3170:                     }
                   3171:                 }
1.591     raeburn  3172:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3173:                     $locarg = $in{'curr_autharg'};
                   3174:                 }
                   3175:             } else {
                   3176:                 $result = &mt('Currently using local (institutional) authentication.');
                   3177:                 return $result;
1.165     raeburn  3178:             }
                   3179:         }
1.586     raeburn  3180:     } else {
                   3181:         if ($authnum == 1) {
1.784     bisitz   3182:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3183:         }
                   3184:     }
                   3185:     if (!$can_assign{'loc'}) {
                   3186:         return;
1.587     raeburn  3187:     } elsif ($authtype eq '') {
1.591     raeburn  3188:         if (defined($in{'mode'})) {
1.587     raeburn  3189:             if ($in{'mode'} eq 'modifycourse') {
                   3190:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3191:                     $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587     raeburn  3192:                 }
                   3193:             }
                   3194:         }
1.165     raeburn  3195:     }
1.586     raeburn  3196:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3197:     if ($authtype eq '') {
                   3198:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3199:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117  raeburn  3200:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3201:     }
                   3202:     $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1075.2.117  raeburn  3203:                $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3204:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3205:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3206:     return $result;
                   3207: }
                   3208: 
1.1075.2.20  raeburn  3209: sub authform_filesystem {
1.32      matthew  3210:     my %in = (
                   3211:               formname => 'document.cu',
                   3212:               kerb_def_dom => 'MSU.EDU',
                   3213:               @_,
                   3214:               );
1.1075.2.117  raeburn  3215:     my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  3216:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  3217:     if ($in{'readonly'}) {
                   3218:         $disabled = ' disabled="disabled"';
                   3219:     }
1.591     raeburn  3220:     if (defined($in{'curr_authtype'})) {
                   3221:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3222:             if ($can_assign{'fsys'}) {
1.772     bisitz   3223:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3224:                 if (defined($in{'mode'})) {
                   3225:                     if ($in{'mode'} eq 'modifyuser') {
                   3226:                         $fsyscheck = '';
                   3227:                     }
                   3228:                 }
1.586     raeburn  3229:             } else {
                   3230:                 $result = &mt('Currently Filesystem Authenticated.');
                   3231:                 return $result;
                   3232:             }           
                   3233:         }
                   3234:     } else {
                   3235:         if ($authnum == 1) {
1.784     bisitz   3236:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3237:         }
                   3238:     }
                   3239:     if (!$can_assign{'fsys'}) {
                   3240:         return;
1.587     raeburn  3241:     } elsif ($authtype eq '') {
1.591     raeburn  3242:         if (defined($in{'mode'})) {
1.587     raeburn  3243:             if ($in{'mode'} eq 'modifycourse') {
                   3244:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3245:                     $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587     raeburn  3246:                 }
                   3247:             }
                   3248:         }
1.586     raeburn  3249:     }
                   3250:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3251:     if ($authtype eq '') {
                   3252:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3253:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117  raeburn  3254:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3255:     }
1.1075.2.158  raeburn  3256:     $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1075.2.117  raeburn  3257:                ' onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3258:     $result = &mt
1.144     matthew  3259:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1075.2.158  raeburn  3260:          '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3261:     return $result;
                   3262: }
                   3263: 
1.1075.2.161.  .17(raeb 3264:-23): sub authform_lti {
                   3265:-23):     my %in = (
                   3266:-23):               formname => 'document.cu',
                   3267:-23):               kerb_def_dom => 'MSU.EDU',
                   3268:-23):               @_,
                   3269:-23):               );
                   3270:-23):     my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
                   3271:-23):     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
                   3272:-23):     if ($in{'readonly'}) {
                   3273:-23):         $disabled = ' disabled="disabled"';
                   3274:-23):     }
                   3275:-23):     if (defined($in{'curr_authtype'})) {
                   3276:-23):         if ($in{'curr_authtype'} eq 'lti') {
                   3277:-23):             if ($can_assign{'lti'}) {
                   3278:-23):                 $lticheck = 'checked="checked" ';
                   3279:-23):                 if (defined($in{'mode'})) {
                   3280:-23):                     if ($in{'mode'} eq 'modifyuser') {
                   3281:-23):                         $lticheck = '';
                   3282:-23):                     }
                   3283:-23):                 }
                   3284:-23):             } else {
                   3285:-23):                 $result = &mt('Currently LTI Authenticated.');
                   3286:-23):                 return $result;
                   3287:-23):             }
                   3288:-23):         }
                   3289:-23):     } else {
                   3290:-23):         if ($authnum == 1) {
                   3291:-23):             $authtype = '<input type="hidden" name="login" value="lti" />';
                   3292:-23):         }
                   3293:-23):     }
                   3294:-23):     if (!$can_assign{'lti'}) {
                   3295:-23):         return;
                   3296:-23):     } elsif ($authtype eq '') {
                   3297:-23):         if (defined($in{'mode'})) {
                   3298:-23):             if ($in{'mode'} eq 'modifycourse') {
                   3299:-23):                 if ($authnum == 1) {
                   3300:-23):                     $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
                   3301:-23):                 }
                   3302:-23):             }
                   3303:-23):         }
                   3304:-23):     }
                   3305:-23):     $jscall = "javascript:changed_radio('lti',$in{'formname'});";
                   3306:-23):     if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
                   3307:-23):         $authtype = '<input type="radio" name="login" value="lti" '.
                   3308:-23):                     $lticheck.' onchange="'.$jscall.'" onclick="'.
                   3309:-23):                     $jscall.'"'.$disabled.' />';
                   3310:-23):     }
                   3311:-23):     $autharg = '<input type="hidden" name="ltiarg" value="" />';
                   3312:-23):     if ($authtype) {
                   3313:-23):         $result = &mt('[_1] LTI Authenticated',
                   3314:-23):                       '<label>'.$authtype.'</label>'.$autharg);
                   3315:-23):     } else {
                   3316:-23):         $result = '<b>'.&mt('LTI Authenticated').'</b>'.
                   3317:-23):                   $autharg;
                   3318:-23):     }
                   3319:-23):     return $result;
                   3320:-23): }
                   3321:-23): 
1.586     raeburn  3322: sub get_assignable_auth {
                   3323:     my ($dom) = @_;
                   3324:     if ($dom eq '') {
                   3325:         $dom = $env{'request.role.domain'};
                   3326:     }
                   3327:     my %can_assign = (
                   3328:                           krb4 => 1,
                   3329:                           krb5 => 1,
                   3330:                           int  => 1,
                   3331:                           loc  => 1,
                   3332:                      );
                   3333:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3334:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3335:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3336:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3337:             my $context;
                   3338:             if ($env{'request.role'} =~ /^au/) {
                   3339:                 $context = 'author';
1.1075.2.117  raeburn  3340:             } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586     raeburn  3341:                 $context = 'domain';
                   3342:             } elsif ($env{'request.course.id'}) {
                   3343:                 $context = 'course';
                   3344:             }
                   3345:             if ($context) {
                   3346:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3347:                    %can_assign = %{$authhash->{$context}}; 
                   3348:                 }
                   3349:             }
                   3350:         }
                   3351:     }
                   3352:     my $authnum = 0;
                   3353:     foreach my $key (keys(%can_assign)) {
                   3354:         if ($can_assign{$key}) {
                   3355:             $authnum ++;
                   3356:         }
                   3357:     }
                   3358:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3359:         $authnum --;
                   3360:     }
                   3361:     return ($authnum,%can_assign);
                   3362: }
                   3363: 
1.1075.2.137  raeburn  3364: sub check_passwd_rules {
                   3365:     my ($domain,$plainpass) = @_;
                   3366:     my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3367:     my ($min,$max,@chars,@brokerule,$warning);
1.1075.2.138  raeburn  3368:     $min = $Apache::lonnet::passwdmin;
1.1075.2.137  raeburn  3369:     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3370:         if ($passwdconf{'min'} =~ /^\d+$/) {
1.1075.2.138  raeburn  3371:             if ($passwdconf{'min'} > $min) {
                   3372:                 $min = $passwdconf{'min'};
                   3373:             }
1.1075.2.137  raeburn  3374:         }
                   3375:         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3376:             $max = $passwdconf{'max'};
                   3377:         }
                   3378:         @chars = @{$passwdconf{'chars'}};
                   3379:     }
                   3380:     if (($min) && (length($plainpass) < $min)) {
                   3381:         push(@brokerule,'min');
                   3382:     }
                   3383:     if (($max) && (length($plainpass) > $max)) {
                   3384:         push(@brokerule,'max');
                   3385:     }
                   3386:     if (@chars) {
                   3387:         my %rules;
                   3388:         map { $rules{$_} = 1; } @chars;
                   3389:         if ($rules{'uc'}) {
                   3390:             unless ($plainpass =~ /[A-Z]/) {
                   3391:                 push(@brokerule,'uc');
                   3392:             }
                   3393:         }
                   3394:         if ($rules{'lc'}) {
                   3395:             unless ($plainpass =~ /[a-z]/) {
                   3396:                 push(@brokerule,'lc');
                   3397:             }
                   3398:         }
                   3399:         if ($rules{'num'}) {
                   3400:             unless ($plainpass =~ /\d/) {
                   3401:                 push(@brokerule,'num');
                   3402:             }
                   3403:         }
                   3404:         if ($rules{'spec'}) {
                   3405:             unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   3406:                 push(@brokerule,'spec');
                   3407:             }
                   3408:         }
                   3409:     }
                   3410:     if (@brokerule) {
                   3411:         my %rulenames = &Apache::lonlocal::texthash(
                   3412:             uc   => 'At least one upper case letter',
                   3413:             lc   => 'At least one lower case letter',
                   3414:             num  => 'At least one number',
                   3415:             spec => 'At least one non-alphanumeric',
                   3416:         );
                   3417:         $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
                   3418:         $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
                   3419:         $rulenames{'num'} .= ': 0123456789';
                   3420:         $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
                   3421:         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
                   3422:         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
                   3423:         $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1075.2.143  raeburn  3424:         foreach my $rule ('min','max','uc','lc','num','spec') {
1.1075.2.137  raeburn  3425:             if (grep(/^$rule$/,@brokerule)) {
                   3426:                 $warning .= '<li>'.$rulenames{$rule}.'</li>';
                   3427:             }
                   3428:         }
                   3429:         $warning .= '</ul>';
                   3430:     }
                   3431:     if (wantarray) {
                   3432:         return @brokerule;
                   3433:     }
                   3434:     return $warning;
                   3435: }
                   3436: 
1.1075.2.161.  .5(raebu 3437:22): sub passwd_validation_js {
                   3438:22):     my ($currpasswdval,$domain,$context,$id) = @_;
                   3439:22):     my (%passwdconf,$alertmsg);
                   3440:22):     if ($context eq 'linkprot') {
                   3441:22):         my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
                   3442:22):         if (ref($domconfig{'ltisec'}) eq 'HASH') {
                   3443:22):             if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
                   3444:22):                 %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
                   3445:22):             }
                   3446:22):         }
                   3447:22):         if ($id eq 'add') {
                   3448:22):             $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
                   3449:22):         } elsif ($id =~ /^\d+$/) {
                   3450:22):             my $pos = $id+1;
                   3451:22):             $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
                   3452:22):         } else {
                   3453:22):             $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
                   3454:22):         }
                   3455:22):     } else {
                   3456:22):         %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3457:22):         $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
                   3458:22):     }
                   3459:22):     my ($min,$max,@chars,$numrules,$intargjs,%alert);
                   3460:22):     $numrules = 0;
                   3461:22):     $min = $Apache::lonnet::passwdmin;
                   3462:22):     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3463:22):         if ($passwdconf{'min'} =~ /^\d+$/) {
                   3464:22):             if ($passwdconf{'min'} > $min) {
                   3465:22):                 $min = $passwdconf{'min'};
                   3466:22):             }
                   3467:22):         }
                   3468:22):         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3469:22):             $max = $passwdconf{'max'};
                   3470:22):             $numrules ++;
                   3471:22):         }
                   3472:22):         @chars = @{$passwdconf{'chars'}};
                   3473:22):         if (@chars) {
                   3474:22):             $numrules ++;
                   3475:22):         }
                   3476:22):     }
                   3477:22):     if ($min > 0) {
                   3478:22):         $numrules ++;
                   3479:22):     }
                   3480:22):     if (($min > 0) || ($max ne '') || (@chars > 0)) {
                   3481:22):         if ($min) {
                   3482:22):             $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
                   3483:22):         }
                   3484:22):         if ($max) {
                   3485:22):             $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
                   3486:22):         }
                   3487:22):         my (@charalerts,@charrules);
                   3488:22):         if (@chars) {
                   3489:22):             if (grep(/^uc$/,@chars)) {
                   3490:22):                 push(@charalerts,&mt('contain at least one upper case letter'));
                   3491:22):                 push(@charrules,'uc');
                   3492:22):             }
                   3493:22):             if (grep(/^lc$/,@chars)) {
                   3494:22):                 push(@charalerts,&mt('contain at least one lower case letter'));
                   3495:22):                 push(@charrules,'lc');
                   3496:22):             }
                   3497:22):             if (grep(/^num$/,@chars)) {
                   3498:22):                 push(@charalerts,&mt('contain at least one number'));
                   3499:22):                 push(@charrules,'num');
                   3500:22):             }
                   3501:22):             if (grep(/^spec$/,@chars)) {
                   3502:22):                 push(@charalerts,&mt('contain at least one non-alphanumeric'));
                   3503:22):                 push(@charrules,'spec');
                   3504:22):             }
                   3505:22):         }
                   3506:22):         $intargjs = qq|            var rulesmsg = '';\n|.
                   3507:22):                     qq|            var currpwval = $currpasswdval;\n|;
                   3508:22):             if ($min) {
                   3509:22):                 $intargjs .= qq|
                   3510:22):             if (currpwval.length < $min) {
                   3511:22):                 rulesmsg += ' - $alert{min}';
                   3512:22):             }
                   3513:22): |;
                   3514:22):             }
                   3515:22):             if ($max) {
                   3516:22):                 $intargjs .= qq|
                   3517:22):             if (currpwval.length > $max) {
                   3518:22):                 rulesmsg += ' - $alert{max}';
                   3519:22):             }
                   3520:22): |;
                   3521:22):             }
                   3522:22):             if (@chars > 0) {
                   3523:22):                 my $charrulestr = '"'.join('","',@charrules).'"';
                   3524:22):                 my $charalertstr = '"'.join('","',@charalerts).'"';
                   3525:22):                 $intargjs .= qq|            var brokerules = new Array();\n|.
                   3526:22):                              qq|            var charrules = new Array($charrulestr);\n|.
                   3527:22):                              qq|            var charalerts = new Array($charalertstr);\n|;
                   3528:22):                 my %rules;
                   3529:22):                 map { $rules{$_} = 1; } @chars;
                   3530:22):                 if ($rules{'uc'}) {
                   3531:22):                     $intargjs .= qq|
                   3532:22):             var ucRegExp = /[A-Z]/;
                   3533:22):             if (!ucRegExp.test(currpwval)) {
                   3534:22):                 brokerules.push('uc');
                   3535:22):             }
                   3536:22): |;
                   3537:22):                 }
                   3538:22):                 if ($rules{'lc'}) {
                   3539:22):                     $intargjs .= qq|
                   3540:22):             var lcRegExp = /[a-z]/;
                   3541:22):             if (!lcRegExp.test(currpwval)) {
                   3542:22):                 brokerules.push('lc');
                   3543:22):             }
                   3544:22): |;
                   3545:22):                 }
                   3546:22):                 if ($rules{'num'}) {
                   3547:22):                      $intargjs .= qq|
                   3548:22):             var numRegExp = /[0-9]/;
                   3549:22):             if (!numRegExp.test(currpwval)) {
                   3550:22):                 brokerules.push('num');
                   3551:22):             }
                   3552:22): |;
                   3553:22):                 }
                   3554:22):                 if ($rules{'spec'}) {
                   3555:22):                      $intargjs .= q|
                   3556:22):             var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
                   3557:22):             if (!specRegExp.test(currpwval)) {
                   3558:22):                 brokerules.push('spec');
                   3559:22):             }
                   3560:22): |;
                   3561:22):                 }
                   3562:22):                 $intargjs .= qq|
                   3563:22):             if (brokerules.length > 0) {
                   3564:22):                 for (var i=0; i<brokerules.length; i++) {
                   3565:22):                     for (var j=0; j<charrules.length; j++) {
                   3566:22):                         if (brokerules[i] == charrules[j]) {
                   3567:22):                             rulesmsg += ' - '+charalerts[j]+'\\n';
                   3568:22):                             break;
                   3569:22):                         }
                   3570:22):                     }
                   3571:22):                 }
                   3572:22):             }
                   3573:22): |;
                   3574:22):             }
                   3575:22):             $intargjs .= qq|
                   3576:22):             if (rulesmsg != '') {
                   3577:22):                 rulesmsg = '$alertmsg'+rulesmsg;
                   3578:22):                 alert(rulesmsg);
                   3579:22):                 return false;
                   3580:22):             }
                   3581:22): |;
                   3582:22):     }
                   3583:22):     return ($numrules,$intargjs);
                   3584:22): }
                   3585:22): 
1.80      albertel 3586: ###############################################################
                   3587: ##    Get Kerberos Defaults for Domain                 ##
                   3588: ###############################################################
                   3589: ##
                   3590: ## Returns default kerberos version and an associated argument
                   3591: ## as listed in file domain.tab. If not listed, provides
                   3592: ## appropriate default domain and kerberos version.
                   3593: ##
                   3594: #-------------------------------------------
                   3595: 
                   3596: =pod
                   3597: 
1.648     raeburn  3598: =item * &get_kerberos_defaults()
1.80      albertel 3599: 
                   3600: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3601: version and domain. If not found, it defaults to version 4 and the 
                   3602: domain of the server.
1.80      albertel 3603: 
1.648     raeburn  3604: =over 4
                   3605: 
1.80      albertel 3606: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3607: 
1.648     raeburn  3608: =back
                   3609: 
                   3610: =back
                   3611: 
1.80      albertel 3612: =cut
                   3613: 
                   3614: #-------------------------------------------
                   3615: sub get_kerberos_defaults {
                   3616:     my $domain=shift;
1.641     raeburn  3617:     my ($krbdef,$krbdefdom);
                   3618:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3619:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3620:         $krbdef = $domdefaults{'auth_def'};
                   3621:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3622:     } else {
1.80      albertel 3623:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3624:         my $krbdefdom=$1;
                   3625:         $krbdefdom=~tr/a-z/A-Z/;
                   3626:         $krbdef = "krb4";
                   3627:     }
                   3628:     return ($krbdef,$krbdefdom);
                   3629: }
1.112     bowersj2 3630: 
1.32      matthew  3631: 
1.46      matthew  3632: ###############################################################
                   3633: ##                Thesaurus Functions                        ##
                   3634: ###############################################################
1.20      www      3635: 
1.46      matthew  3636: =pod
1.20      www      3637: 
1.112     bowersj2 3638: =head1 Thesaurus Functions
                   3639: 
                   3640: =over 4
                   3641: 
1.648     raeburn  3642: =item * &initialize_keywords()
1.46      matthew  3643: 
                   3644: Initializes the package variable %Keywords if it is empty.  Uses the
                   3645: package variable $thesaurus_db_file.
                   3646: 
                   3647: =cut
                   3648: 
                   3649: ###################################################
                   3650: 
                   3651: sub initialize_keywords {
                   3652:     return 1 if (scalar keys(%Keywords));
                   3653:     # If we are here, %Keywords is empty, so fill it up
                   3654:     #   Make sure the file we need exists...
                   3655:     if (! -e $thesaurus_db_file) {
                   3656:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3657:                                  " failed because it does not exist");
                   3658:         return 0;
                   3659:     }
                   3660:     #   Set up the hash as a database
                   3661:     my %thesaurus_db;
                   3662:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3663:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3664:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3665:                                  $thesaurus_db_file);
                   3666:         return 0;
                   3667:     } 
                   3668:     #  Get the average number of appearances of a word.
                   3669:     my $avecount = $thesaurus_db{'average.count'};
                   3670:     #  Put keywords (those that appear > average) into %Keywords
                   3671:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3672:         my ($count,undef) = split /:/,$data;
                   3673:         $Keywords{$word}++ if ($count > $avecount);
                   3674:     }
                   3675:     untie %thesaurus_db;
                   3676:     # Remove special values from %Keywords.
1.356     albertel 3677:     foreach my $value ('total.count','average.count') {
                   3678:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3679:   }
1.46      matthew  3680:     return 1;
                   3681: }
                   3682: 
                   3683: ###################################################
                   3684: 
                   3685: =pod
                   3686: 
1.648     raeburn  3687: =item * &keyword($word)
1.46      matthew  3688: 
                   3689: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3690: than the average number of times in the thesaurus database.  Calls 
                   3691: &initialize_keywords
                   3692: 
                   3693: =cut
                   3694: 
                   3695: ###################################################
1.20      www      3696: 
                   3697: sub keyword {
1.46      matthew  3698:     return if (!&initialize_keywords());
                   3699:     my $word=lc(shift());
                   3700:     $word=~s/\W//g;
                   3701:     return exists($Keywords{$word});
1.20      www      3702: }
1.46      matthew  3703: 
                   3704: ###############################################################
                   3705: 
                   3706: =pod 
1.20      www      3707: 
1.648     raeburn  3708: =item * &get_related_words()
1.46      matthew  3709: 
1.160     matthew  3710: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3711: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3712: will be returned.  The order of the words returned is determined by the
                   3713: database which holds them.
                   3714: 
                   3715: Uses global $thesaurus_db_file.
                   3716: 
1.1057    foxr     3717: 
1.46      matthew  3718: =cut
                   3719: 
                   3720: ###############################################################
                   3721: sub get_related_words {
                   3722:     my $keyword = shift;
                   3723:     my %thesaurus_db;
                   3724:     if (! -e $thesaurus_db_file) {
                   3725:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3726:                                  "failed because the file does not exist");
                   3727:         return ();
                   3728:     }
                   3729:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3730:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3731:         return ();
                   3732:     } 
                   3733:     my @Words=();
1.429     www      3734:     my $count=0;
1.46      matthew  3735:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3736: 	# The first element is the number of times
                   3737: 	# the word appears.  We do not need it now.
1.429     www      3738: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3739: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3740: 	my $threshold=$mostfrequentcount/10;
                   3741:         foreach my $possibleword (@RelatedWords) {
                   3742:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3743:             if ($wordcount>$threshold) {
                   3744: 		push(@Words,$word);
                   3745:                 $count++;
                   3746:                 if ($count>10) { last; }
                   3747: 	    }
1.20      www      3748:         }
                   3749:     }
1.46      matthew  3750:     untie %thesaurus_db;
                   3751:     return @Words;
1.14      harris41 3752: }
1.46      matthew  3753: 
1.112     bowersj2 3754: =pod
                   3755: 
                   3756: =back
                   3757: 
                   3758: =cut
1.61      www      3759: 
                   3760: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3761: =pod
                   3762: 
1.112     bowersj2 3763: =head1 User Name Functions
                   3764: 
                   3765: =over 4
                   3766: 
1.648     raeburn  3767: =item * &plainname($uname,$udom,$first)
1.81      albertel 3768: 
1.112     bowersj2 3769: Takes a users logon name and returns it as a string in
1.226     albertel 3770: "first middle last generation" form 
                   3771: if $first is set to 'lastname' then it returns it as
                   3772: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3773: 
                   3774: =cut
1.61      www      3775: 
1.295     www      3776: 
1.81      albertel 3777: ###############################################################
1.61      www      3778: sub plainname {
1.226     albertel 3779:     my ($uname,$udom,$first)=@_;
1.537     albertel 3780:     return if (!defined($uname) || !defined($udom));
1.295     www      3781:     my %names=&getnames($uname,$udom);
1.226     albertel 3782:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3783: 					  $names{'middlename'},
                   3784: 					  $names{'lastname'},
                   3785: 					  $names{'generation'},$first);
                   3786:     $name=~s/^\s+//;
1.62      www      3787:     $name=~s/\s+$//;
                   3788:     $name=~s/\s+/ /g;
1.353     albertel 3789:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3790:     return $name;
1.61      www      3791: }
1.66      www      3792: 
                   3793: # -------------------------------------------------------------------- Nickname
1.81      albertel 3794: =pod
                   3795: 
1.648     raeburn  3796: =item * &nickname($uname,$udom)
1.81      albertel 3797: 
                   3798: Gets a users name and returns it as a string as
                   3799: 
                   3800: "&quot;nickname&quot;"
1.66      www      3801: 
1.81      albertel 3802: if the user has a nickname or
                   3803: 
                   3804: "first middle last generation"
                   3805: 
                   3806: if the user does not
                   3807: 
                   3808: =cut
1.66      www      3809: 
                   3810: sub nickname {
                   3811:     my ($uname,$udom)=@_;
1.537     albertel 3812:     return if (!defined($uname) || !defined($udom));
1.295     www      3813:     my %names=&getnames($uname,$udom);
1.68      albertel 3814:     my $name=$names{'nickname'};
1.66      www      3815:     if ($name) {
                   3816:        $name='&quot;'.$name.'&quot;'; 
                   3817:     } else {
                   3818:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3819: 	     $names{'lastname'}.' '.$names{'generation'};
                   3820:        $name=~s/\s+$//;
                   3821:        $name=~s/\s+/ /g;
                   3822:     }
                   3823:     return $name;
                   3824: }
                   3825: 
1.295     www      3826: sub getnames {
                   3827:     my ($uname,$udom)=@_;
1.537     albertel 3828:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3829:     if ($udom eq 'public' && $uname eq 'public') {
                   3830: 	return ('lastname' => &mt('Public'));
                   3831:     }
1.295     www      3832:     my $id=$uname.':'.$udom;
                   3833:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3834:     if ($cached) {
                   3835: 	return %{$names};
                   3836:     } else {
                   3837: 	my %loadnames=&Apache::lonnet::get('environment',
                   3838:                     ['firstname','middlename','lastname','generation','nickname'],
                   3839: 					 $udom,$uname);
                   3840: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3841: 	return %loadnames;
                   3842:     }
                   3843: }
1.61      www      3844: 
1.542     raeburn  3845: # -------------------------------------------------------------------- getemails
1.648     raeburn  3846: 
1.542     raeburn  3847: =pod
                   3848: 
1.648     raeburn  3849: =item * &getemails($uname,$udom)
1.542     raeburn  3850: 
                   3851: Gets a user's email information and returns it as a hash with keys:
                   3852: notification, critnotification, permanentemail
                   3853: 
                   3854: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3855: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3856:  
1.648     raeburn  3857: 
1.542     raeburn  3858: =cut
                   3859: 
1.648     raeburn  3860: 
1.466     albertel 3861: sub getemails {
                   3862:     my ($uname,$udom)=@_;
                   3863:     if ($udom eq 'public' && $uname eq 'public') {
                   3864: 	return;
                   3865:     }
1.467     www      3866:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3867:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3868:     my $id=$uname.':'.$udom;
                   3869:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3870:     if ($cached) {
                   3871: 	return %{$names};
                   3872:     } else {
                   3873: 	my %loadnames=&Apache::lonnet::get('environment',
                   3874:                     			   ['notification','critnotification',
                   3875: 					    'permanentemail'],
                   3876: 					   $udom,$uname);
                   3877: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3878: 	return %loadnames;
                   3879:     }
                   3880: }
                   3881: 
1.551     albertel 3882: sub flush_email_cache {
                   3883:     my ($uname,$udom)=@_;
                   3884:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3885:     if (!$uname) { $uname=$env{'user.name'};   }
                   3886:     return if ($udom eq 'public' && $uname eq 'public');
                   3887:     my $id=$uname.':'.$udom;
                   3888:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3889: }
                   3890: 
1.728     raeburn  3891: # -------------------------------------------------------------------- getlangs
                   3892: 
                   3893: =pod
                   3894: 
                   3895: =item * &getlangs($uname,$udom)
                   3896: 
                   3897: Gets a user's language preference and returns it as a hash with key:
                   3898: language.
                   3899: 
                   3900: =cut
                   3901: 
                   3902: 
                   3903: sub getlangs {
                   3904:     my ($uname,$udom) = @_;
                   3905:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3906:     if (!$uname) { $uname=$env{'user.name'};   }
                   3907:     my $id=$uname.':'.$udom;
                   3908:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3909:     if ($cached) {
                   3910:         return %{$langs};
                   3911:     } else {
                   3912:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3913:                                            $udom,$uname);
                   3914:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3915:         return %loadlangs;
                   3916:     }
                   3917: }
                   3918: 
                   3919: sub flush_langs_cache {
                   3920:     my ($uname,$udom)=@_;
                   3921:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3922:     if (!$uname) { $uname=$env{'user.name'};   }
                   3923:     return if ($udom eq 'public' && $uname eq 'public');
                   3924:     my $id=$uname.':'.$udom;
                   3925:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3926: }
                   3927: 
1.61      www      3928: # ------------------------------------------------------------------ Screenname
1.81      albertel 3929: 
                   3930: =pod
                   3931: 
1.648     raeburn  3932: =item * &screenname($uname,$udom)
1.81      albertel 3933: 
                   3934: Gets a users screenname and returns it as a string
                   3935: 
                   3936: =cut
1.61      www      3937: 
                   3938: sub screenname {
                   3939:     my ($uname,$udom)=@_;
1.258     albertel 3940:     if ($uname eq $env{'user.name'} &&
                   3941: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3942:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3943:     return $names{'screenname'};
1.62      www      3944: }
                   3945: 
1.212     albertel 3946: 
1.802     bisitz   3947: # ------------------------------------------------------------- Confirm Wrapper
                   3948: =pod
                   3949: 
1.1075.2.42  raeburn  3950: =item * &confirmwrapper($message)
1.802     bisitz   3951: 
                   3952: Wrap messages about completion of operation in box
                   3953: 
                   3954: =cut
                   3955: 
                   3956: sub confirmwrapper {
                   3957:     my ($message)=@_;
                   3958:     if ($message) {
                   3959:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3960:                .$message."\n"
                   3961:                .'</div>'."\n";
                   3962:     } else {
                   3963:         return $message;
                   3964:     }
                   3965: }
                   3966: 
1.62      www      3967: # ------------------------------------------------------------- Message Wrapper
                   3968: 
                   3969: sub messagewrapper {
1.369     www      3970:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3971:     return 
1.441     albertel 3972:         '<a href="/adm/email?compose=individual&amp;'.
                   3973:         'recname='.$username.'&amp;recdom='.$domain.
                   3974: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3975:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3976: }
1.802     bisitz   3977: 
1.74      www      3978: # --------------------------------------------------------------- Notes Wrapper
                   3979: 
                   3980: sub noteswrapper {
                   3981:     my ($link,$un,$do)=@_;
                   3982:     return 
1.896     amueller 3983: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3984: }
1.802     bisitz   3985: 
1.62      www      3986: # ------------------------------------------------------------- Aboutme Wrapper
                   3987: 
                   3988: sub aboutmewrapper {
1.1070    raeburn  3989:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3990:     if (!defined($username)  && !defined($domain)) {
                   3991:         return;
                   3992:     }
1.1075.2.15  raeburn  3993:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3994: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3995: }
                   3996: 
                   3997: # ------------------------------------------------------------ Syllabus Wrapper
                   3998: 
                   3999: sub syllabuswrapper {
1.707     bisitz   4000:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  4001:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      4002: }
1.14      harris41 4003: 
1.1075.2.161.  .11(raeb 4004:-22): sub aboutme_on {
                   4005:-22):     my ($uname,$udom)=@_;
                   4006:-22):     unless ($uname) { $uname=$env{'user.name'}; }
                   4007:-22):     unless ($udom)  { $udom=$env{'user.domain'}; }
                   4008:-22):     return if ($udom eq 'public' && $uname eq 'public');
                   4009:-22):     my $hashkey=$uname.':'.$udom;
                   4010:-22):     my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
                   4011:-22):     if ($cached) {
                   4012:-22):         return $aboutme;
                   4013:-22):     }
                   4014:-22):     $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
                   4015:-22):     &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
                   4016:-22):     return $aboutme;
                   4017:-22): }
                   4018:-22): 
                   4019:-22): sub devalidate_aboutme_cache {
                   4020:-22):     my ($uname,$udom)=@_;
                   4021:-22):     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4022:-22):     if (!$uname) { $uname=$env{'user.name'};   }
                   4023:-22):     return if ($udom eq 'public' && $uname eq 'public');
                   4024:-22):     my $id=$uname.':'.$udom;
                   4025:-22):     &Apache::lonnet::devalidate_cache_new('aboutme',$id);
                   4026:-22): }
                   4027:-22): 
1.802     bisitz   4028: # -----------------------------------------------------------------------------
                   4029: 
1.208     matthew  4030: sub track_student_link {
1.887     raeburn  4031:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 4032:     my $link ="/adm/trackstudent?";
1.208     matthew  4033:     my $title = 'View recent activity';
                   4034:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   4035:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 4036:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  4037:         $title .= ' of this student';
1.268     albertel 4038:     } 
1.208     matthew  4039:     if (defined($target) && $target !~ /^\s*$/) {
                   4040:         $target = qq{target="$target"};
                   4041:     } else {
                   4042:         $target = '';
                   4043:     }
1.268     albertel 4044:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  4045:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 4046:     $title = &mt($title);
                   4047:     $linktext = &mt($linktext);
1.448     albertel 4048:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   4049: 	&help_open_topic('View_recent_activity');
1.208     matthew  4050: }
                   4051: 
1.781     raeburn  4052: sub slot_reservations_link {
                   4053:     my ($linktext,$sname,$sdom,$target) = @_;
                   4054:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   4055:     my $title = 'View slot reservation history';
                   4056:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   4057:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   4058:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   4059:         $title .= ' of this student';
                   4060:     }
                   4061:     if (defined($target) && $target !~ /^\s*$/) {
                   4062:         $target = qq{target="$target"};
                   4063:     } else {
                   4064:         $target = '';
                   4065:     }
                   4066:     $title = &mt($title);
                   4067:     $linktext = &mt($linktext);
                   4068:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   4069: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   4070: 
                   4071: }
                   4072: 
1.508     www      4073: # ===================================================== Display a student photo
                   4074: 
                   4075: 
1.509     albertel 4076: sub student_image_tag {
1.508     www      4077:     my ($domain,$user)=@_;
                   4078:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   4079:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   4080: 	return '<img src="'.$imgsrc.'" align="right" />';
                   4081:     } else {
                   4082: 	return '';
                   4083:     }
                   4084: }
                   4085: 
1.112     bowersj2 4086: =pod
                   4087: 
                   4088: =back
                   4089: 
                   4090: =head1 Access .tab File Data
                   4091: 
                   4092: =over 4
                   4093: 
1.648     raeburn  4094: =item * &languageids() 
1.112     bowersj2 4095: 
                   4096: returns list of all language ids
                   4097: 
                   4098: =cut
                   4099: 
1.14      harris41 4100: sub languageids {
1.16      harris41 4101:     return sort(keys(%language));
1.14      harris41 4102: }
                   4103: 
1.112     bowersj2 4104: =pod
                   4105: 
1.648     raeburn  4106: =item * &languagedescription() 
1.112     bowersj2 4107: 
                   4108: returns description of a specified language id
                   4109: 
                   4110: =cut
                   4111: 
1.14      harris41 4112: sub languagedescription {
1.125     www      4113:     my $code=shift;
                   4114:     return  ($supported_language{$code}?'* ':'').
                   4115:             $language{$code}.
1.126     www      4116: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      4117: }
                   4118: 
1.1048    foxr     4119: =pod
                   4120: 
                   4121: =item * &plainlanguagedescription
                   4122: 
                   4123: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   4124: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   4125: 
                   4126: =cut
                   4127: 
1.145     www      4128: sub plainlanguagedescription {
                   4129:     my $code=shift;
                   4130:     return $language{$code};
                   4131: }
                   4132: 
1.1048    foxr     4133: =pod
                   4134: 
                   4135: =item * &supportedlanguagecode
                   4136: 
                   4137: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   4138: code.
                   4139: 
                   4140: =cut
                   4141: 
1.145     www      4142: sub supportedlanguagecode {
                   4143:     my $code=shift;
                   4144:     return $supported_language{$code};
1.97      www      4145: }
                   4146: 
1.112     bowersj2 4147: =pod
                   4148: 
1.1048    foxr     4149: =item * &latexlanguage()
                   4150: 
                   4151: Given a language key code returns the correspondnig language to use
                   4152: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   4153: is no supported hyphenation for the language code.
                   4154: 
                   4155: =cut
                   4156: 
                   4157: sub latexlanguage {
                   4158:     my $code = shift;
                   4159:     return $latex_language{$code};
                   4160: }
                   4161: 
                   4162: =pod
                   4163: 
                   4164: =item * &latexhyphenation()
                   4165: 
                   4166: Same as above but what's supplied is the language as it might be stored
                   4167: in the metadata.
                   4168: 
                   4169: =cut
                   4170: 
                   4171: sub latexhyphenation {
                   4172:     my $key = shift;
                   4173:     return $latex_language_bykey{$key};
                   4174: }
                   4175: 
                   4176: =pod
                   4177: 
1.648     raeburn  4178: =item * &copyrightids() 
1.112     bowersj2 4179: 
                   4180: returns list of all copyrights
                   4181: 
                   4182: =cut
                   4183: 
                   4184: sub copyrightids {
                   4185:     return sort(keys(%cprtag));
                   4186: }
                   4187: 
                   4188: =pod
                   4189: 
1.648     raeburn  4190: =item * &copyrightdescription() 
1.112     bowersj2 4191: 
                   4192: returns description of a specified copyright id
                   4193: 
                   4194: =cut
                   4195: 
                   4196: sub copyrightdescription {
1.166     www      4197:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 4198: }
1.197     matthew  4199: 
                   4200: =pod
                   4201: 
1.648     raeburn  4202: =item * &source_copyrightids() 
1.192     taceyjo1 4203: 
                   4204: returns list of all source copyrights
                   4205: 
                   4206: =cut
                   4207: 
                   4208: sub source_copyrightids {
                   4209:     return sort(keys(%scprtag));
                   4210: }
                   4211: 
                   4212: =pod
                   4213: 
1.648     raeburn  4214: =item * &source_copyrightdescription() 
1.192     taceyjo1 4215: 
                   4216: returns description of a specified source copyright id
                   4217: 
                   4218: =cut
                   4219: 
                   4220: sub source_copyrightdescription {
                   4221:     return &mt($scprtag{shift(@_)});
                   4222: }
1.112     bowersj2 4223: 
                   4224: =pod
                   4225: 
1.648     raeburn  4226: =item * &filecategories() 
1.112     bowersj2 4227: 
                   4228: returns list of all file categories
                   4229: 
                   4230: =cut
                   4231: 
                   4232: sub filecategories {
                   4233:     return sort(keys(%category_extensions));
                   4234: }
                   4235: 
                   4236: =pod
                   4237: 
1.648     raeburn  4238: =item * &filecategorytypes() 
1.112     bowersj2 4239: 
                   4240: returns list of file types belonging to a given file
                   4241: category
                   4242: 
                   4243: =cut
                   4244: 
                   4245: sub filecategorytypes {
1.356     albertel 4246:     my ($cat) = @_;
                   4247:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 4248: }
                   4249: 
                   4250: =pod
                   4251: 
1.648     raeburn  4252: =item * &fileembstyle() 
1.112     bowersj2 4253: 
                   4254: returns embedding style for a specified file type
                   4255: 
                   4256: =cut
                   4257: 
                   4258: sub fileembstyle {
                   4259:     return $fe{lc(shift(@_))};
1.169     www      4260: }
                   4261: 
1.351     www      4262: sub filemimetype {
                   4263:     return $fm{lc(shift(@_))};
                   4264: }
                   4265: 
1.169     www      4266: 
                   4267: sub filecategoryselect {
                   4268:     my ($name,$value)=@_;
1.189     matthew  4269:     return &select_form($value,$name,
1.970     raeburn  4270:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 4271: }
                   4272: 
                   4273: =pod
                   4274: 
1.648     raeburn  4275: =item * &filedescription() 
1.112     bowersj2 4276: 
                   4277: returns description for a specified file type
                   4278: 
                   4279: =cut
                   4280: 
                   4281: sub filedescription {
1.188     matthew  4282:     my $file_description = $fd{lc(shift())};
                   4283:     $file_description =~ s:([\[\]]):~$1:g;
                   4284:     return &mt($file_description);
1.112     bowersj2 4285: }
                   4286: 
                   4287: =pod
                   4288: 
1.648     raeburn  4289: =item * &filedescriptionex() 
1.112     bowersj2 4290: 
                   4291: returns description for a specified file type with
                   4292: extra formatting
                   4293: 
                   4294: =cut
                   4295: 
                   4296: sub filedescriptionex {
                   4297:     my $ex=shift;
1.188     matthew  4298:     my $file_description = $fd{lc($ex)};
                   4299:     $file_description =~ s:([\[\]]):~$1:g;
                   4300:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 4301: }
                   4302: 
                   4303: # End of .tab access
                   4304: =pod
                   4305: 
                   4306: =back
                   4307: 
                   4308: =cut
                   4309: 
                   4310: # ------------------------------------------------------------------ File Types
                   4311: sub fileextensions {
                   4312:     return sort(keys(%fe));
                   4313: }
                   4314: 
1.97      www      4315: # ----------------------------------------------------------- Display Languages
                   4316: # returns a hash with all desired display languages
                   4317: #
                   4318: 
                   4319: sub display_languages {
                   4320:     my %languages=();
1.695     raeburn  4321:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 4322: 	$languages{$lang}=1;
1.97      www      4323:     }
                   4324:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 4325:     if ($env{'form.displaylanguage'}) {
1.356     albertel 4326: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   4327: 	    $languages{$lang}=1;
1.97      www      4328:         }
                   4329:     }
                   4330:     return %languages;
1.14      harris41 4331: }
                   4332: 
1.582     albertel 4333: sub languages {
                   4334:     my ($possible_langs) = @_;
1.695     raeburn  4335:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 4336:     if (!ref($possible_langs)) {
                   4337: 	if( wantarray ) {
                   4338: 	    return @preferred_langs;
                   4339: 	} else {
                   4340: 	    return $preferred_langs[0];
                   4341: 	}
                   4342:     }
                   4343:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   4344:     my @preferred_possibilities;
                   4345:     foreach my $preferred_lang (@preferred_langs) {
                   4346: 	if (exists($possibilities{$preferred_lang})) {
                   4347: 	    push(@preferred_possibilities, $preferred_lang);
                   4348: 	}
                   4349:     }
                   4350:     if( wantarray ) {
                   4351: 	return @preferred_possibilities;
                   4352:     }
                   4353:     return $preferred_possibilities[0];
                   4354: }
                   4355: 
1.742     raeburn  4356: sub user_lang {
                   4357:     my ($touname,$toudom,$fromcid) = @_;
                   4358:     my @userlangs;
                   4359:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   4360:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   4361:                     $env{'course.'.$fromcid.'.languages'}));
                   4362:     } else {
                   4363:         my %langhash = &getlangs($touname,$toudom);
                   4364:         if ($langhash{'languages'} ne '') {
                   4365:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   4366:         } else {
                   4367:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   4368:             if ($domdefs{'lang_def'} ne '') {
                   4369:                 @userlangs = ($domdefs{'lang_def'});
                   4370:             }
                   4371:         }
                   4372:     }
                   4373:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4374:     my $user_lh = Apache::localize->get_handle(@languages);
                   4375:     return $user_lh;
                   4376: }
                   4377: 
                   4378: 
1.112     bowersj2 4379: ###############################################################
                   4380: ##               Student Answer Attempts                     ##
                   4381: ###############################################################
                   4382: 
                   4383: =pod
                   4384: 
                   4385: =head1 Alternate Problem Views
                   4386: 
                   4387: =over 4
                   4388: 
1.648     raeburn  4389: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86  raeburn  4390:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4391: 
                   4392: Return string with previous attempt on problem. Arguments:
                   4393: 
                   4394: =over 4
                   4395: 
                   4396: =item * $symb: Problem, including path
                   4397: 
                   4398: =item * $username: username of the desired student
                   4399: 
                   4400: =item * $domain: domain of the desired student
1.14      harris41 4401: 
1.112     bowersj2 4402: =item * $course: Course ID
1.14      harris41 4403: 
1.112     bowersj2 4404: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4405:     something
1.14      harris41 4406: 
1.112     bowersj2 4407: =item * $regexp: if string matches this regexp, the string will be
                   4408:     sent to $gradesub
1.14      harris41 4409: 
1.112     bowersj2 4410: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4411: 
1.1075.2.86  raeburn  4412: =item * $usec: section of the desired student
                   4413: 
                   4414: =item * $identifier: counter for student (multiple students one problem) or
                   4415:     problem (one student; whole sequence).
                   4416: 
1.112     bowersj2 4417: =back
1.14      harris41 4418: 
1.112     bowersj2 4419: The output string is a table containing all desired attempts, if any.
1.16      harris41 4420: 
1.112     bowersj2 4421: =cut
1.1       albertel 4422: 
                   4423: sub get_previous_attempt {
1.1075.2.86  raeburn  4424:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4425:   my $prevattempts='';
1.43      ng       4426:   no strict 'refs';
1.1       albertel 4427:   if ($symb) {
1.3       albertel 4428:     my (%returnhash)=
                   4429:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4430:     if ($returnhash{'version'}) {
                   4431:       my %lasthash=();
                   4432:       my $version;
                   4433:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91  raeburn  4434:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4435:             if ($key =~ /\.rawrndseed$/) {
                   4436:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4437:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4438:             } else {
                   4439:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4440:             }
1.19      harris41 4441:         }
1.1       albertel 4442:       }
1.596     albertel 4443:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4444:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86  raeburn  4445:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4446:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4447:       foreach my $key (sort(keys(%lasthash))) {
                   4448: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4449: 	if ($#parts > 0) {
1.31      albertel 4450: 	  my $data=$parts[-1];
1.989     raeburn  4451:           next if ($data eq 'foilorder');
1.31      albertel 4452: 	  pop(@parts);
1.1010    www      4453:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4454:           if ($data eq 'type') {
                   4455:               unless ($showsurv) {
                   4456:                   my $id = join(',',@parts);
                   4457:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4458:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4459:                       $lasthidden{$ign.'.'.$id} = 1;
                   4460:                   }
1.945     raeburn  4461:               }
1.1075.2.86  raeburn  4462:               if ($identifier ne '') {
                   4463:                   my $id = join(',',@parts);
                   4464:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4465:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4466:                       $hidestatus{$ign.'.'.$id} = 1;
                   4467:                   }
                   4468:               }
                   4469:           } elsif ($data eq 'regrader') {
                   4470:               if (($identifier ne '') && (@parts)) {
                   4471:                   my $id = join(',',@parts);
                   4472:                   $regraded{$ign.'.'.$id} = 1;
                   4473:               }
1.1010    www      4474:           } 
1.31      albertel 4475: 	} else {
1.41      ng       4476: 	  if ($#parts == 0) {
                   4477: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4478: 	  } else {
                   4479: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4480: 	  }
1.31      albertel 4481: 	}
1.16      harris41 4482:       }
1.596     albertel 4483:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4484:       if ($getattempt eq '') {
1.1075.2.86  raeburn  4485:         my (%solved,%resets,%probstatus);
                   4486:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4487:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4488:                 foreach my $id (keys(%regraded)) {
                   4489:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4490:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4491:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4492:                         push(@{$resets{$id}},$version);
                   4493:                     }
                   4494:                 }
                   4495:             }
                   4496:         }
1.40      ng       4497: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86  raeburn  4498:             my (@hidden,@unsolved);
1.945     raeburn  4499:             if (%typeparts) {
                   4500:                 foreach my $id (keys(%typeparts)) {
1.1075.2.86  raeburn  4501:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
                   4502:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4503:                         push(@hidden,$id);
1.1075.2.86  raeburn  4504:                     } elsif ($identifier ne '') {
                   4505:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4506:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4507:                                 ($hidestatus{$id})) {
                   4508:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
                   4509:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4510:                                 push(@{$solved{$id}},$version);
                   4511:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4512:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4513:                                 my $skip;
                   4514:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4515:                                     foreach my $reset (@{$resets{$id}}) {
                   4516:                                         if ($reset > $solved{$id}[-1]) {
                   4517:                                             $skip=1;
                   4518:                                             last;
                   4519:                                         }
                   4520:                                     }
                   4521:                                 }
                   4522:                                 unless ($skip) {
                   4523:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4524:                                     push(@unsolved,$partslist);
                   4525:                                 }
                   4526:                             }
                   4527:                         }
1.945     raeburn  4528:                     }
                   4529:                 }
                   4530:             }
                   4531:             $prevattempts.=&start_data_table_row().
1.1075.2.86  raeburn  4532:                            '<td>'.&mt('Transaction [_1]',$version);
                   4533:             if (@unsolved) {
                   4534:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4535:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4536:                                  &mt('Hide').'</label></span>';
                   4537:             }
                   4538:             $prevattempts .= '</td>';
1.945     raeburn  4539:             if (@hidden) {
                   4540:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4541:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4542:                     my $hide;
                   4543:                     foreach my $id (@hidden) {
                   4544:                         if ($key =~ /^\Q$id\E/) {
                   4545:                             $hide = 1;
                   4546:                             last;
                   4547:                         }
                   4548:                     }
                   4549:                     if ($hide) {
                   4550:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4551:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4552:                             my $value = &format_previous_attempt_value($key,
                   4553:                                              $returnhash{$version.':'.$key});
                   4554:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4555:                         } else {
                   4556:                             $prevattempts.='<td>&nbsp;</td>';
                   4557:                         }
                   4558:                     } else {
                   4559:                         if ($key =~ /\./) {
1.1075.2.91  raeburn  4560:                             my $value = $returnhash{$version.':'.$key};
                   4561:                             if ($key =~ /\.rndseed$/) {
                   4562:                                 my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   4563:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4564:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4565:                                 }
                   4566:                             }
                   4567:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4568:                                            '&nbsp;</td>';
1.945     raeburn  4569:                         } else {
                   4570:                             $prevattempts.='<td>&nbsp;</td>';
                   4571:                         }
                   4572:                     }
                   4573:                 }
                   4574:             } else {
                   4575: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4576:                     next if ($key =~ /\.foilorder$/);
1.1075.2.91  raeburn  4577:                     my $value = $returnhash{$version.':'.$key};
                   4578:                     if ($key =~ /\.rndseed$/) {
                   4579:                         my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   4580:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4581:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4582:                         }
                   4583:                     }
                   4584:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4585:                                    '&nbsp;</td>';
1.945     raeburn  4586: 	        }
                   4587:             }
                   4588: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4589: 	 }
1.1       albertel 4590:       }
1.945     raeburn  4591:       my @currhidden = keys(%lasthidden);
1.596     albertel 4592:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4593:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4594:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4595:           if (%typeparts) {
                   4596:               my $hidden;
                   4597:               foreach my $id (@currhidden) {
                   4598:                   if ($key =~ /^\Q$id\E/) {
                   4599:                       $hidden = 1;
                   4600:                       last;
                   4601:                   }
                   4602:               }
                   4603:               if ($hidden) {
                   4604:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4605:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4606:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4607:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4608:                           $value = &$gradesub($value);
                   4609:                       }
                   4610:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4611:                   } else {
                   4612:                       $prevattempts.='<td>&nbsp;</td>';
                   4613:                   }
                   4614:               } else {
                   4615:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4616:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4617:                       $value = &$gradesub($value);
                   4618:                   }
                   4619:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4620:               }
                   4621:           } else {
                   4622: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4623: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4624:                   $value = &$gradesub($value);
                   4625:               }
                   4626: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4627:           }
1.16      harris41 4628:       }
1.596     albertel 4629:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4630:     } else {
1.1075.2.161.  .17(raeb 4631:-23):       my $msg;
                   4632:-23):       if ($symb =~ /ext\.tool$/) {
                   4633:-23):           $msg = &mt('No grade passed back.');
                   4634:-23):       } else {
                   4635:-23):           $msg = &mt('Nothing submitted - no attempts.');
                   4636:-23):       }
1.596     albertel 4637:       $prevattempts=
                   4638: 	  &start_data_table().&start_data_table_row().
1.1075.2.161.  .17(raeb 4639:-23): 	  '<td>'.$msg.'</td>'.
1.596     albertel 4640: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4641:     }
                   4642:   } else {
1.596     albertel 4643:     $prevattempts=
                   4644: 	  &start_data_table().&start_data_table_row().
                   4645: 	  '<td>'.&mt('No data.').'</td>'.
                   4646: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4647:   }
1.10      albertel 4648: }
                   4649: 
1.581     albertel 4650: sub format_previous_attempt_value {
                   4651:     my ($key,$value) = @_;
1.1011    www      4652:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 4653: 	$value = &Apache::lonlocal::locallocaltime($value);
                   4654:     } elsif (ref($value) eq 'ARRAY') {
                   4655: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  4656:     } elsif ($key =~ /answerstring$/) {
                   4657:         my %answers = &Apache::lonnet::str2hash($value);
                   4658:         my @anskeys = sort(keys(%answers));
                   4659:         if (@anskeys == 1) {
                   4660:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4661:             if ($answer =~ m{\0}) {
                   4662:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4663:             }
                   4664:             my $tag_internal_answer_name = 'INTERNAL';
                   4665:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4666:                 $value = $answer; 
                   4667:             } else {
                   4668:                 $value = $anskeys[0].'='.$answer;
                   4669:             }
                   4670:         } else {
                   4671:             foreach my $ans (@anskeys) {
                   4672:                 my $answer = $answers{$ans};
1.1001    raeburn  4673:                 if ($answer =~ m{\0}) {
                   4674:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4675:                 }
                   4676:                 $value .=  $ans.'='.$answer.'<br />';;
                   4677:             } 
                   4678:         }
1.581     albertel 4679:     } else {
                   4680: 	$value = &unescape($value);
                   4681:     }
                   4682:     return $value;
                   4683: }
                   4684: 
                   4685: 
1.107     albertel 4686: sub relative_to_absolute {
                   4687:     my ($url,$output)=@_;
                   4688:     my $parser=HTML::TokeParser->new(\$output);
                   4689:     my $token;
                   4690:     my $thisdir=$url;
                   4691:     my @rlinks=();
                   4692:     while ($token=$parser->get_token) {
                   4693: 	if ($token->[0] eq 'S') {
                   4694: 	    if ($token->[1] eq 'a') {
                   4695: 		if ($token->[2]->{'href'}) {
                   4696: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4697: 		}
                   4698: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4699: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4700: 	    } elsif ($token->[1] eq 'base') {
                   4701: 		$thisdir=$token->[2]->{'href'};
                   4702: 	    }
                   4703: 	}
                   4704:     }
                   4705:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4706:     foreach my $link (@rlinks) {
1.726     raeburn  4707: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4708: 		($link=~/^\//) ||
                   4709: 		($link=~/^javascript:/i) ||
                   4710: 		($link=~/^mailto:/i) ||
                   4711: 		($link=~/^\#/)) {
                   4712: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4713: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4714: 	}
                   4715:     }
                   4716: # -------------------------------------------------- Deal with Applet codebases
                   4717:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4718:     return $output;
                   4719: }
                   4720: 
1.112     bowersj2 4721: =pod
                   4722: 
1.648     raeburn  4723: =item * &get_student_view()
1.112     bowersj2 4724: 
                   4725: show a snapshot of what student was looking at
                   4726: 
                   4727: =cut
                   4728: 
1.10      albertel 4729: sub get_student_view {
1.186     albertel 4730:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4731:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4732:   my (%form);
1.10      albertel 4733:   my @elements=('symb','courseid','domain','username');
                   4734:   foreach my $element (@elements) {
1.186     albertel 4735:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4736:   }
1.186     albertel 4737:   if (defined($moreenv)) {
                   4738:       %form=(%form,%{$moreenv});
                   4739:   }
1.236     albertel 4740:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4741:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4742:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4743:   $userview=~s/\<body[^\>]*\>//gi;
                   4744:   $userview=~s/\<\/body\>//gi;
                   4745:   $userview=~s/\<html\>//gi;
                   4746:   $userview=~s/\<\/html\>//gi;
                   4747:   $userview=~s/\<head\>//gi;
                   4748:   $userview=~s/\<\/head\>//gi;
                   4749:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4750:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4751:   if (wantarray) {
                   4752:      return ($userview,$response);
                   4753:   } else {
                   4754:      return $userview;
                   4755:   }
                   4756: }
                   4757: 
                   4758: sub get_student_view_with_retries {
                   4759:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4760: 
                   4761:     my $ok = 0;                 # True if we got a good response.
                   4762:     my $content;
                   4763:     my $response;
                   4764: 
                   4765:     # Try to get the student_view done. within the retries count:
                   4766:     
                   4767:     do {
                   4768:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4769:          $ok      = $response->is_success;
                   4770:          if (!$ok) {
                   4771:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4772:          }
                   4773:          $retries--;
                   4774:     } while (!$ok && ($retries > 0));
                   4775:     
                   4776:     if (!$ok) {
                   4777:        $content = '';          # On error return an empty content.
                   4778:     }
1.651     www      4779:     if (wantarray) {
                   4780:        return ($content, $response);
                   4781:     } else {
                   4782:        return $content;
                   4783:     }
1.11      albertel 4784: }
                   4785: 
1.1075.2.149  raeburn  4786: sub css_links {
                   4787:     my ($currsymb,$level) = @_;
                   4788:     my ($links,@symbs,%cssrefs,%httpref);
                   4789:     if ($level eq 'map') {
                   4790:         my $navmap = Apache::lonnavmaps::navmap->new();
                   4791:         if (ref($navmap)) {
                   4792:             my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
                   4793:             my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
                   4794:             foreach my $res (@resources) {
                   4795:                 if (ref($res) && $res->symb()) {
                   4796:                     push(@symbs,$res->symb());
                   4797:                 }
                   4798:             }
                   4799:         }
                   4800:     } else {
                   4801:         @symbs = ($currsymb);
                   4802:     }
                   4803:     foreach my $symb (@symbs) {
                   4804:         my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
                   4805:         if ($css_href =~ /\S/) {
                   4806:             unless ($css_href =~ m{https?://}) {
                   4807:                 my $url = (&Apache::lonnet::decode_symb($symb))[-1];
                   4808:                 my $proburl =  &Apache::lonnet::clutter($url);
                   4809:                 my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
                   4810:                 unless ($css_href =~ m{^/}) {
                   4811:                     $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
                   4812:                 }
                   4813:                 if ($css_href =~ m{^/(res|uploaded)/}) {
                   4814:                     unless (($httpref{'httpref.'.$css_href}) ||
                   4815:                             (&Apache::lonnet::is_on_map($css_href))) {
                   4816:                         my $thisurl = $proburl;
                   4817:                         if ($env{'httpref.'.$proburl}) {
                   4818:                             $thisurl = $env{'httpref.'.$proburl};
                   4819:                         }
                   4820:                         $httpref{'httpref.'.$css_href} = $thisurl;
                   4821:                     }
                   4822:                 }
                   4823:             }
                   4824:             $cssrefs{$css_href} = 1;
                   4825:         }
                   4826:     }
                   4827:     if (keys(%httpref)) {
                   4828:         &Apache::lonnet::appenv(\%httpref);
                   4829:     }
                   4830:     if (keys(%cssrefs)) {
                   4831:         foreach my $css_href (keys(%cssrefs)) {
                   4832:             next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
                   4833:             $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
                   4834:         }
                   4835:     }
                   4836:     return $links;
                   4837: }
                   4838: 
1.112     bowersj2 4839: =pod
                   4840: 
1.648     raeburn  4841: =item * &get_student_answers() 
1.112     bowersj2 4842: 
                   4843: show a snapshot of how student was answering problem
                   4844: 
                   4845: =cut
                   4846: 
1.11      albertel 4847: sub get_student_answers {
1.100     sakharuk 4848:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4849:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4850:   my (%moreenv);
1.11      albertel 4851:   my @elements=('symb','courseid','domain','username');
                   4852:   foreach my $element (@elements) {
1.186     albertel 4853:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4854:   }
1.186     albertel 4855:   $moreenv{'grade_target'}='answer';
                   4856:   %moreenv=(%form,%moreenv);
1.497     raeburn  4857:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4858:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4859:   return $userview;
1.1       albertel 4860: }
1.116     albertel 4861: 
                   4862: =pod
                   4863: 
                   4864: =item * &submlink()
                   4865: 
1.242     albertel 4866: Inputs: $text $uname $udom $symb $target
1.116     albertel 4867: 
                   4868: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4869: 
                   4870: =cut
                   4871: 
                   4872: ###############################################
                   4873: sub submlink {
1.242     albertel 4874:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4875:     if (!($uname && $udom)) {
                   4876: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4877: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4878: 	if (!$symb) { $symb=$cursymb; }
                   4879:     }
1.254     matthew  4880:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4881:     $symb=&escape($symb);
1.960     bisitz   4882:     if ($target) { $target=" target=\"$target\""; }
                   4883:     return
                   4884:         '<a href="/adm/grades?command=submission'.
                   4885:         '&amp;symb='.$symb.
                   4886:         '&amp;student='.$uname.
                   4887:         '&amp;userdom='.$udom.'"'.
                   4888:         $target.'>'.$text.'</a>';
1.242     albertel 4889: }
                   4890: ##############################################
                   4891: 
                   4892: =pod
                   4893: 
                   4894: =item * &pgrdlink()
                   4895: 
                   4896: Inputs: $text $uname $udom $symb $target
                   4897: 
                   4898: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4899: 
                   4900: =cut
                   4901: 
                   4902: ###############################################
                   4903: sub pgrdlink {
                   4904:     my $link=&submlink(@_);
                   4905:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4906:     return $link;
                   4907: }
                   4908: ##############################################
                   4909: 
                   4910: =pod
                   4911: 
                   4912: =item * &pprmlink()
                   4913: 
                   4914: Inputs: $text $uname $udom $symb $target
                   4915: 
                   4916: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4917: student and a specific resource
1.242     albertel 4918: 
                   4919: =cut
                   4920: 
                   4921: ###############################################
                   4922: sub pprmlink {
                   4923:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4924:     if (!($uname && $udom)) {
                   4925: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4926: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4927: 	if (!$symb) { $symb=$cursymb; }
                   4928:     }
1.254     matthew  4929:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4930:     $symb=&escape($symb);
1.242     albertel 4931:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4932:     return '<a href="/adm/parmset?command=set&amp;'.
                   4933: 	'symb='.$symb.'&amp;uname='.$uname.
                   4934: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4935: }
                   4936: ##############################################
1.37      matthew  4937: 
1.112     bowersj2 4938: =pod
                   4939: 
                   4940: =back
                   4941: 
                   4942: =cut
                   4943: 
1.37      matthew  4944: ###############################################
1.51      www      4945: 
                   4946: 
                   4947: sub timehash {
1.687     raeburn  4948:     my ($thistime) = @_;
                   4949:     my $timezone = &Apache::lonlocal::gettimezone();
                   4950:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4951:                      ->set_time_zone($timezone);
                   4952:     my $wday = $dt->day_of_week();
                   4953:     if ($wday == 7) { $wday = 0; }
                   4954:     return ( 'second' => $dt->second(),
                   4955:              'minute' => $dt->minute(),
                   4956:              'hour'   => $dt->hour(),
                   4957:              'day'     => $dt->day_of_month(),
                   4958:              'month'   => $dt->month(),
                   4959:              'year'    => $dt->year(),
                   4960:              'weekday' => $wday,
                   4961:              'dayyear' => $dt->day_of_year(),
                   4962:              'dlsav'   => $dt->is_dst() );
1.51      www      4963: }
                   4964: 
1.370     www      4965: sub utc_string {
                   4966:     my ($date)=@_;
1.371     www      4967:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4968: }
                   4969: 
1.51      www      4970: sub maketime {
                   4971:     my %th=@_;
1.687     raeburn  4972:     my ($epoch_time,$timezone,$dt);
                   4973:     $timezone = &Apache::lonlocal::gettimezone();
                   4974:     eval {
                   4975:         $dt = DateTime->new( year   => $th{'year'},
                   4976:                              month  => $th{'month'},
                   4977:                              day    => $th{'day'},
                   4978:                              hour   => $th{'hour'},
                   4979:                              minute => $th{'minute'},
                   4980:                              second => $th{'second'},
                   4981:                              time_zone => $timezone,
                   4982:                          );
                   4983:     };
                   4984:     if (!$@) {
                   4985:         $epoch_time = $dt->epoch;
                   4986:         if ($epoch_time) {
                   4987:             return $epoch_time;
                   4988:         }
                   4989:     }
1.51      www      4990:     return POSIX::mktime(
                   4991:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4992:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4993: }
                   4994: 
                   4995: #########################################
1.51      www      4996: 
                   4997: sub findallcourses {
1.482     raeburn  4998:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4999:     my %roles;
                   5000:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 5001:     my %courses;
1.51      www      5002:     my $now=time;
1.482     raeburn  5003:     if (!defined($uname)) {
                   5004:         $uname = $env{'user.name'};
                   5005:     }
                   5006:     if (!defined($udom)) {
                   5007:         $udom = $env{'user.domain'};
                   5008:     }
                   5009:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  5010:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  5011:         if (!%roles) {
                   5012:             %roles = (
                   5013:                        cc => 1,
1.907     raeburn  5014:                        co => 1,
1.482     raeburn  5015:                        in => 1,
                   5016:                        ep => 1,
                   5017:                        ta => 1,
                   5018:                        cr => 1,
                   5019:                        st => 1,
                   5020:              );
                   5021:         }
                   5022:         foreach my $entry (keys(%roleshash)) {
                   5023:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   5024:             if ($trole =~ /^cr/) { 
                   5025:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   5026:             } else {
                   5027:                 next if (!exists($roles{$trole}));
                   5028:             }
                   5029:             if ($tend) {
                   5030:                 next if ($tend < $now);
                   5031:             }
                   5032:             if ($tstart) {
                   5033:                 next if ($tstart > $now);
                   5034:             }
1.1058    raeburn  5035:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  5036:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  5037:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  5038:             if ($secpart eq '') {
                   5039:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   5040:                 $sec = 'none';
1.1058    raeburn  5041:                 $value .= $cnum.'/';
1.482     raeburn  5042:             } else {
                   5043:                 $cnum = $cnumpart;
                   5044:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  5045:                 $value .= $cnum.'/'.$sec;
                   5046:             }
                   5047:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   5048:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   5049:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   5050:                 }
                   5051:             } else {
                   5052:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  5053:             }
1.482     raeburn  5054:         }
                   5055:     } else {
                   5056:         foreach my $key (keys(%env)) {
1.483     albertel 5057: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   5058:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  5059: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   5060: 	        next if ($role eq 'ca' || $role eq 'aa');
                   5061: 	        next if (%roles && !exists($roles{$role}));
                   5062: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   5063:                 my $active=1;
                   5064:                 if ($starttime) {
                   5065: 		    if ($now<$starttime) { $active=0; }
                   5066:                 }
                   5067:                 if ($endtime) {
                   5068:                     if ($now>$endtime) { $active=0; }
                   5069:                 }
                   5070:                 if ($active) {
1.1058    raeburn  5071:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  5072:                     if ($sec eq '') {
                   5073:                         $sec = 'none';
1.1058    raeburn  5074:                     } else {
                   5075:                         $value .= $sec;
                   5076:                     }
                   5077:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   5078:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   5079:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   5080:                         }
                   5081:                     } else {
                   5082:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  5083:                     }
1.474     raeburn  5084:                 }
                   5085:             }
1.51      www      5086:         }
                   5087:     }
1.474     raeburn  5088:     return %courses;
1.51      www      5089: }
1.37      matthew  5090: 
1.54      www      5091: ###############################################
1.474     raeburn  5092: 
                   5093: sub blockcheck {
1.1075.2.158  raeburn  5094:     my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.490     raeburn  5095: 
1.1075.2.161.  .4(raebu 5096:22):     unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
1.1075.2.158  raeburn  5097:         my ($has_evb,$check_ipaccess);
                   5098:         my $dom = $env{'user.domain'};
                   5099:         if ($env{'request.course.id'}) {
                   5100:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5101:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5102:             my $checkrole = "cm./$cdom/$cnum";
                   5103:             my $sec = $env{'request.course.sec'};
                   5104:             if ($sec ne '') {
                   5105:                 $checkrole .= "/$sec";
                   5106:             }
                   5107:             if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   5108:                 ($env{'request.role'} !~ /^st/)) {
                   5109:                 $has_evb = 1;
                   5110:             }
                   5111:             unless ($has_evb) {
                   5112:                 if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
                   5113:                     ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
                   5114:                     if ($udom eq $cdom) {
                   5115:                         $check_ipaccess = 1;
                   5116:                     }
                   5117:                 }
                   5118:             }
1.1075.2.161.  .3(raebu 5119:22):         } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
                   5120:22):                 ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
                   5121:22):             my $checkrole;
                   5122:22):             if ($env{'request.role.domain'} eq '') {
                   5123:22):                 $checkrole = "cm./$env{'user.domain'}/";
                   5124:22):             } else {
                   5125:22):                 $checkrole = "cm./$env{'request.role.domain'}/";
                   5126:22):             }
                   5127:22):             if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
                   5128:22):                 $has_evb = 1;
                   5129:22):             }
1.1075.2.158  raeburn  5130:         }
                   5131:         unless ($has_evb || $check_ipaccess) {
                   5132:             my @machinedoms = &Apache::lonnet::current_machine_domains();
                   5133:             if (($dom eq 'public') && ($activity eq 'port')) {
                   5134:                 $dom = $udom;
                   5135:             }
                   5136:             if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
                   5137:                 $check_ipaccess = 1;
                   5138:             } else {
                   5139:                 my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   5140:                 my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
                   5141:                 my $prim = &Apache::lonnet::domain($dom,'primary');
                   5142:                 my $intdom = &Apache::lonnet::internet_dom($prim);
                   5143:                 if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
                   5144:                     if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
                   5145:                         $check_ipaccess = 1;
                   5146:                     }
                   5147:                 }
                   5148:             }
                   5149:         }
                   5150:         if ($check_ipaccess) {
                   5151:             my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
                   5152:             unless (defined($cached)) {
                   5153:                 my %domconfig =
                   5154:                     &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
                   5155:                 $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
                   5156:             }
                   5157:             if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
                   5158:                 foreach my $id (keys(%{$ipaccessref})) {
                   5159:                     if (ref($ipaccessref->{$id}) eq 'HASH') {
                   5160:                         my $range = $ipaccessref->{$id}->{'ip'};
                   5161:                         if ($range) {
                   5162:                             if (&Apache::lonnet::ip_match($clientip,$range)) {
                   5163:                                 if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
                   5164:                                     if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
                   5165:                                         return ('','','',$id,$dom);
                   5166:                                         last;
                   5167:                                     }
                   5168:                                 }
                   5169:                             }
                   5170:                         }
                   5171:                     }
                   5172:                 }
                   5173:             }
                   5174:         }
1.1075.2.161.  .4(raebu 5175:22):         if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
                   5176:22):             return ();
                   5177:22):         }
1.1075.2.158  raeburn  5178:     }
1.1075.2.73  raeburn  5179:     if (defined($udom) && defined($uname)) {
                   5180:         # If uname and udom are for a course, check for blocks in the course.
                   5181:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   5182:             my ($startblock,$endblock,$triggerblock) =
1.1075.2.147  raeburn  5183:                 &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1075.2.73  raeburn  5184:             return ($startblock,$endblock,$triggerblock);
                   5185:         }
                   5186:     } else {
1.490     raeburn  5187:         $udom = $env{'user.domain'};
                   5188:         $uname = $env{'user.name'};
                   5189:     }
                   5190: 
1.502     raeburn  5191:     my $startblock = 0;
                   5192:     my $endblock = 0;
1.1062    raeburn  5193:     my $triggerblock = '';
1.1075.2.160  raeburn  5194:     my %live_courses;
                   5195:     unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
                   5196:         %live_courses = &findallcourses(undef,$uname,$udom);
                   5197:     }
1.474     raeburn  5198: 
1.490     raeburn  5199:     # If uname is for a user, and activity is course-specific, i.e.,
                   5200:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  5201: 
1.490     raeburn  5202:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.161.  .1(raebu 5203:21):          $activity eq 'groups' || $activity eq 'printout' ||
                   5204:21):          $activity eq 'search' || $activity eq 'reinit' ||
                   5205:21):          $activity eq 'alert') && ($env{'request.course.id'})) {
1.490     raeburn  5206:         foreach my $key (keys(%live_courses)) {
                   5207:             if ($key ne $env{'request.course.id'}) {
                   5208:                 delete($live_courses{$key});
                   5209:             }
                   5210:         }
                   5211:     }
                   5212: 
                   5213:     my $otheruser = 0;
                   5214:     my %own_courses;
                   5215:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   5216:         # Resource belongs to user other than current user.
                   5217:         $otheruser = 1;
                   5218:         # Gather courses for current user
                   5219:         %own_courses = 
                   5220:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   5221:     }
                   5222: 
                   5223:     # Gather active course roles - course coordinator, instructor, 
                   5224:     # exam proctor, ta, student, or custom role.
1.474     raeburn  5225: 
                   5226:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  5227:         my ($cdom,$cnum);
                   5228:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   5229:             $cdom = $env{'course.'.$course.'.domain'};
                   5230:             $cnum = $env{'course.'.$course.'.num'};
                   5231:         } else {
1.490     raeburn  5232:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  5233:         }
                   5234:         my $no_ownblock = 0;
                   5235:         my $no_userblock = 0;
1.533     raeburn  5236:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  5237:             # Check if current user has 'evb' priv for this
                   5238:             if (defined($own_courses{$course})) {
                   5239:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   5240:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   5241:                     if ($sec ne 'none') {
                   5242:                         $checkrole .= '/'.$sec;
                   5243:                     }
                   5244:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5245:                         $no_ownblock = 1;
                   5246:                         last;
                   5247:                     }
                   5248:                 }
                   5249:             }
                   5250:             # if they have 'evb' priv and are currently not playing student
                   5251:             next if (($no_ownblock) &&
                   5252:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   5253:         }
1.474     raeburn  5254:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  5255:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  5256:             if ($sec ne 'none') {
1.482     raeburn  5257:                 $checkrole .= '/'.$sec;
1.474     raeburn  5258:             }
1.490     raeburn  5259:             if ($otheruser) {
                   5260:                 # Resource belongs to user other than current user.
                   5261:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  5262:                 my (%allroles,%userroles);
                   5263:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   5264:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   5265:                         my ($trole,$tdom,$tnum,$tsec);
                   5266:                         if ($entry =~ /^cr/) {
                   5267:                             ($trole,$tdom,$tnum,$tsec) = 
                   5268:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   5269:                         } else {
                   5270:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   5271:                         }
                   5272:                         my ($spec,$area,$trest);
                   5273:                         $area = '/'.$tdom.'/'.$tnum;
                   5274:                         $trest = $tnum;
                   5275:                         if ($tsec ne '') {
                   5276:                             $area .= '/'.$tsec;
                   5277:                             $trest .= '/'.$tsec;
                   5278:                         }
                   5279:                         $spec = $trole.'.'.$area;
                   5280:                         if ($trole =~ /^cr/) {
                   5281:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   5282:                                                               $tdom,$spec,$trest,$area);
                   5283:                         } else {
                   5284:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   5285:                                                                 $tdom,$spec,$trest,$area);
                   5286:                         }
                   5287:                     }
1.1075.2.124  raeburn  5288:                     my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058    raeburn  5289:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   5290:                         if ($1) {
                   5291:                             $no_userblock = 1;
                   5292:                             last;
                   5293:                         }
1.486     raeburn  5294:                     }
                   5295:                 }
1.490     raeburn  5296:             } else {
                   5297:                 # Resource belongs to current user
                   5298:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  5299:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5300:                     $no_ownblock = 1;
                   5301:                     last;
                   5302:                 }
1.474     raeburn  5303:             }
                   5304:         }
                   5305:         # if they have the evb priv and are currently not playing student
1.482     raeburn  5306:         next if (($no_ownblock) &&
1.491     albertel 5307:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  5308:         next if ($no_userblock);
1.474     raeburn  5309: 
1.1075.2.128  raeburn  5310:         # Retrieve blocking times and identity of blocker for course
1.490     raeburn  5311:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  5312:         
1.1062    raeburn  5313:         my ($start,$end,$trigger) = 
1.1075.2.147  raeburn  5314:             &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502     raeburn  5315:         if (($start != 0) && 
                   5316:             (($startblock == 0) || ($startblock > $start))) {
                   5317:             $startblock = $start;
1.1062    raeburn  5318:             if ($trigger ne '') {
                   5319:                 $triggerblock = $trigger;
                   5320:             }
1.502     raeburn  5321:         }
                   5322:         if (($end != 0)  &&
                   5323:             (($endblock == 0) || ($endblock < $end))) {
                   5324:             $endblock = $end;
1.1062    raeburn  5325:             if ($trigger ne '') {
                   5326:                 $triggerblock = $trigger;
                   5327:             }
1.502     raeburn  5328:         }
1.490     raeburn  5329:     }
1.1062    raeburn  5330:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  5331: }
                   5332: 
                   5333: sub get_blocks {
1.1075.2.147  raeburn  5334:     my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490     raeburn  5335:     my $startblock = 0;
                   5336:     my $endblock = 0;
1.1062    raeburn  5337:     my $triggerblock = '';
1.490     raeburn  5338:     my $course = $cdom.'_'.$cnum;
                   5339:     $setters->{$course} = {};
                   5340:     $setters->{$course}{'staff'} = [];
                   5341:     $setters->{$course}{'times'} = [];
1.1062    raeburn  5342:     $setters->{$course}{'triggers'} = [];
                   5343:     my (@blockers,%triggered);
                   5344:     my $now = time;
                   5345:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   5346:     if ($activity eq 'docs') {
1.1075.2.148  raeburn  5347:         my ($blocked,$nosymbcache,$noenccheck);
1.1075.2.147  raeburn  5348:         if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
                   5349:             $blocked = 1;
                   5350:             $nosymbcache = 1;
1.1075.2.148  raeburn  5351:             $noenccheck = 1;
1.1075.2.147  raeburn  5352:         }
1.1075.2.148  raeburn  5353:         @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062    raeburn  5354:         foreach my $block (@blockers) {
                   5355:             if ($block =~ /^firstaccess____(.+)$/) {
                   5356:                 my $item = $1;
                   5357:                 my $type = 'map';
                   5358:                 my $timersymb = $item;
                   5359:                 if ($item eq 'course') {
                   5360:                     $type = 'course';
                   5361:                 } elsif ($item =~ /___\d+___/) {
                   5362:                     $type = 'resource';
                   5363:                 } else {
                   5364:                     $timersymb = &Apache::lonnet::symbread($item);
                   5365:                 }
                   5366:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5367:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   5368:                 $triggered{$block} = {
                   5369:                                        start => $start,
                   5370:                                        end   => $end,
                   5371:                                        type  => $type,
                   5372:                                      };
                   5373:             }
                   5374:         }
                   5375:     } else {
                   5376:         foreach my $block (keys(%commblocks)) {
                   5377:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   5378:                 my ($start,$end) = ($1,$2);
                   5379:                 if ($start <= time && $end >= time) {
                   5380:                     if (ref($commblocks{$block}) eq 'HASH') {
                   5381:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5382:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5383:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   5384:                                     push(@blockers,$block);
                   5385:                                 }
                   5386:                             }
                   5387:                         }
                   5388:                     }
                   5389:                 }
                   5390:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   5391:                 my $item = $1;
                   5392:                 my $timersymb = $item; 
                   5393:                 my $type = 'map';
                   5394:                 if ($item eq 'course') {
                   5395:                     $type = 'course';
                   5396:                 } elsif ($item =~ /___\d+___/) {
                   5397:                     $type = 'resource';
                   5398:                 } else {
                   5399:                     $timersymb = &Apache::lonnet::symbread($item);
                   5400:                 }
                   5401:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5402:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   5403:                 if ($start && $end) {
                   5404:                     if (($start <= time) && ($end >= time)) {
1.1075.2.158  raeburn  5405:                         if (ref($commblocks{$block}) eq 'HASH') {
                   5406:                             if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5407:                                 if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5408:                                     unless(grep(/^\Q$block\E$/,@blockers)) {
                   5409:                                         push(@blockers,$block);
                   5410:                                         $triggered{$block} = {
                   5411:                                                                start => $start,
                   5412:                                                                end   => $end,
                   5413:                                                                type  => $type,
                   5414:                                                              };
                   5415:                                     }
                   5416:                                 }
                   5417:                             }
1.1062    raeburn  5418:                         }
                   5419:                     }
1.490     raeburn  5420:                 }
1.1062    raeburn  5421:             }
                   5422:         }
                   5423:     }
                   5424:     foreach my $blocker (@blockers) {
                   5425:         my ($staff_name,$staff_dom,$title,$blocks) =
                   5426:             &parse_block_record($commblocks{$blocker});
                   5427:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   5428:         my ($start,$end,$triggertype);
                   5429:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   5430:             ($start,$end) = ($1,$2);
                   5431:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   5432:             $start = $triggered{$blocker}{'start'};
                   5433:             $end = $triggered{$blocker}{'end'};
                   5434:             $triggertype = $triggered{$blocker}{'type'};
                   5435:         }
                   5436:         if ($start) {
                   5437:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   5438:             if ($triggertype) {
                   5439:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   5440:             } else {
                   5441:                 push(@{$$setters{$course}{'triggers'}},0);
                   5442:             }
                   5443:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   5444:                 $startblock = $start;
                   5445:                 if ($triggertype) {
                   5446:                     $triggerblock = $blocker;
1.474     raeburn  5447:                 }
                   5448:             }
1.1062    raeburn  5449:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   5450:                $endblock = $end;
                   5451:                if ($triggertype) {
                   5452:                    $triggerblock = $blocker;
                   5453:                }
                   5454:             }
1.474     raeburn  5455:         }
                   5456:     }
1.1062    raeburn  5457:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  5458: }
                   5459: 
                   5460: sub parse_block_record {
                   5461:     my ($record) = @_;
                   5462:     my ($setuname,$setudom,$title,$blocks);
                   5463:     if (ref($record) eq 'HASH') {
                   5464:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   5465:         $title = &unescape($record->{'event'});
                   5466:         $blocks = $record->{'blocks'};
                   5467:     } else {
                   5468:         my @data = split(/:/,$record,3);
                   5469:         if (scalar(@data) eq 2) {
                   5470:             $title = $data[1];
                   5471:             ($setuname,$setudom) = split(/@/,$data[0]);
                   5472:         } else {
                   5473:             ($setuname,$setudom,$title) = @data;
                   5474:         }
                   5475:         $blocks = { 'com' => 'on' };
                   5476:     }
                   5477:     return ($setuname,$setudom,$title,$blocks);
                   5478: }
                   5479: 
1.854     kalberla 5480: sub blocking_status {
1.1075.2.158  raeburn  5481:     my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061    raeburn  5482:     my %setters;
1.890     droeschl 5483: 
1.1061    raeburn  5484: # check for active blocking
1.1075.2.158  raeburn  5485:     if ($clientip eq '') {
                   5486:         $clientip = &Apache::lonnet::get_requestor_ip();
                   5487:     }
                   5488:     my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
                   5489:         &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062    raeburn  5490:     my $blocked = 0;
1.1075.2.158  raeburn  5491:     if (($startblock && $endblock) || ($by_ip)) {
1.1062    raeburn  5492:         $blocked = 1;
                   5493:     }
1.890     droeschl 5494: 
1.1061    raeburn  5495: # caller just wants to know whether a block is active
                   5496:     if (!wantarray) { return $blocked; }
                   5497: 
                   5498: # build a link to a popup window containing the details
                   5499:     my $querystring  = "?activity=$activity";
1.1075.2.158  raeburn  5500: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
                   5501:     if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1075.2.97  raeburn  5502:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);
                   5503:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  5504:     } elsif ($activity eq 'docs') {
1.1075.2.147  raeburn  5505:         my $showurl = &Apache::lonenc::check_encrypt($url);
                   5506:         $querystring .= '&amp;url='.&HTML::Entities::encode($showurl,'\'&"<>');
                   5507:         if ($symb) {
                   5508:             my $showsymb = &Apache::lonenc::check_encrypt($symb);
                   5509:             $querystring .= '&amp;symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
                   5510:         }
1.1062    raeburn  5511:     }
1.1061    raeburn  5512: 
                   5513:     my $output .= <<'END_MYBLOCK';
                   5514: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   5515:     var options = "width=" + w + ",height=" + h + ",";
                   5516:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   5517:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   5518:     var newWin = window.open(url, wdwName, options);
                   5519:     newWin.focus();
                   5520: }
1.890     droeschl 5521: END_MYBLOCK
1.854     kalberla 5522: 
1.1061    raeburn  5523:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 5524:   
1.1061    raeburn  5525:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  5526:     my $text = &mt('Communication Blocked');
1.1075.2.93  raeburn  5527:     my $class = 'LC_comblock';
1.1062    raeburn  5528:     if ($activity eq 'docs') {
                   5529:         $text = &mt('Content Access Blocked');
1.1075.2.93  raeburn  5530:         $class = '';
1.1063    raeburn  5531:     } elsif ($activity eq 'printout') {
                   5532:         $text = &mt('Printing Blocked');
1.1075.2.97  raeburn  5533:     } elsif ($activity eq 'passwd') {
                   5534:         $text = &mt('Password Changing Blocked');
1.1075.2.158  raeburn  5535:     } elsif ($activity eq 'grades') {
                   5536:         $text = &mt('Gradebook Blocked');
                   5537:     } elsif ($activity eq 'search') {
                   5538:         $text = &mt('Search Blocked');
1.1075.2.161.  .1(raebu 5539:21):     } elsif ($activity eq 'alert') {
                   5540:21):         $text = &mt('Checking Critical Messages Blocked');
                   5541:21):     } elsif ($activity eq 'reinit') {
                   5542:21):         $text = &mt('Checking Course Update Blocked');
1.1075.2.158  raeburn  5543:     } elsif ($activity eq 'about') {
                   5544:         $text = &mt('Access to User Information Pages Blocked');
1.1075.2.160  raeburn  5545:     } elsif ($activity eq 'wishlist') {
                   5546:         $text = &mt('Access to Stored Links Blocked');
                   5547:     } elsif ($activity eq 'annotate') {
                   5548:         $text = &mt('Access to Annotations Blocked');
1.1062    raeburn  5549:     }
1.1061    raeburn  5550:     $output .= <<"END_BLOCK";
1.1075.2.93  raeburn  5551: <div class='$class'>
1.869     kalberla 5552:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5553:   title='$text'>
                   5554:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5555:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5556:   title='$text'>$text</a>
1.867     kalberla 5557: </div>
                   5558: 
                   5559: END_BLOCK
1.474     raeburn  5560: 
1.1061    raeburn  5561:     return ($blocked, $output);
1.854     kalberla 5562: }
1.490     raeburn  5563: 
1.60      matthew  5564: ###############################################
                   5565: 
1.682     raeburn  5566: sub check_ip_acc {
1.1075.2.105  raeburn  5567:     my ($acc,$clientip)=@_;
1.682     raeburn  5568:     &Apache::lonxml::debug("acc is $acc");
                   5569:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5570:         return 1;
                   5571:     }
                   5572:     my $allowed=0;
1.1075.2.144  raeburn  5573:     my $ip;
                   5574:     if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
                   5575:         ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
                   5576:         $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
                   5577:     } else {
1.1075.2.150  raeburn  5578:         my $remote_ip = &Apache::lonnet::get_requestor_ip();
                   5579:         $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1075.2.144  raeburn  5580:     }
1.682     raeburn  5581: 
                   5582:     my $name;
1.1075.2.161.  .1(raebu 5583:21):     my %access = (
                   5584:21):                      allowfrom => 1,
                   5585:21):                      denyfrom  => 0,
                   5586:21):                  );
                   5587:21):     my @allows;
                   5588:21):     my @denies;
                   5589:21):     foreach my $item (split(',',$acc)) {
                   5590:21):         $item =~ s/^\s*//;
                   5591:21):         $item =~ s/\s*$//;
                   5592:21):         if ($item =~ /^\!(.+)$/) {
                   5593:21):             push(@denies,$1);
                   5594:21):         } else {
                   5595:21):             push(@allows,$item);
                   5596:21):         }
                   5597:21):     }
                   5598:21):     my $numdenies = scalar(@denies);
                   5599:21):     my $numallows = scalar(@allows);
                   5600:21):     my $count = 0;
                   5601:21):     foreach my $pattern (@denies,@allows) {
                   5602:21):         $count ++;
                   5603:21):         my $acctype = 'allowfrom';
                   5604:21):         if ($count <= $numdenies) {
                   5605:21):             $acctype = 'denyfrom';
                   5606:21):         }
1.682     raeburn  5607:         if ($pattern =~ /\*$/) {
                   5608:             #35.8.*
                   5609:             $pattern=~s/\*//;
1.1075.2.161.  .1(raebu 5610:21):             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5611:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5612:             #35.8.3.[34-56]
                   5613:             my $low=$2;
                   5614:             my $high=$3;
                   5615:             $pattern=$1;
                   5616:             if ($ip =~ /^\Q$pattern\E/) {
                   5617:                 my $last=(split(/\./,$ip))[3];
1.1075.2.161.  .1(raebu 5618:21):                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  5619:             }
                   5620:         } elsif ($pattern =~ /^\*/) {
                   5621:             #*.msu.edu
                   5622:             $pattern=~s/\*//;
                   5623:             if (!defined($name)) {
                   5624:                 use Socket;
                   5625:                 my $netaddr=inet_aton($ip);
                   5626:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5627:             }
1.1075.2.161.  .1(raebu 5628:21):             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  5629:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5630:             #127.0.0.1
1.1075.2.161.  .1(raebu 5631:21):             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5632:         } else {
                   5633:             #some.name.com
                   5634:             if (!defined($name)) {
                   5635:                 use Socket;
                   5636:                 my $netaddr=inet_aton($ip);
                   5637:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5638:             }
1.1075.2.161.  .1(raebu 5639:21):             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   5640:21):         }
                   5641:21):         if ($allowed =~ /^(0|1)$/) { last; }
                   5642:21):     }
                   5643:21):     if ($allowed eq '') {
                   5644:21):         if ($numdenies && !$numallows) {
                   5645:21):             $allowed = 1;
                   5646:21):         } else {
                   5647:21):             $allowed = 0;
1.682     raeburn  5648:         }
                   5649:     }
                   5650:     return $allowed;
                   5651: }
                   5652: 
                   5653: ###############################################
                   5654: 
1.60      matthew  5655: =pod
                   5656: 
1.112     bowersj2 5657: =head1 Domain Template Functions
                   5658: 
                   5659: =over 4
                   5660: 
                   5661: =item * &determinedomain()
1.60      matthew  5662: 
                   5663: Inputs: $domain (usually will be undef)
                   5664: 
1.63      www      5665: Returns: Determines which domain should be used for designs
1.60      matthew  5666: 
                   5667: =cut
1.54      www      5668: 
1.60      matthew  5669: ###############################################
1.63      www      5670: sub determinedomain {
                   5671:     my $domain=shift;
1.531     albertel 5672:     if (! $domain) {
1.60      matthew  5673:         # Determine domain if we have not been given one
1.893     raeburn  5674:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5675:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5676:         if ($env{'request.role.domain'}) { 
                   5677:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5678:         }
                   5679:     }
1.63      www      5680:     return $domain;
                   5681: }
                   5682: ###############################################
1.517     raeburn  5683: 
1.518     albertel 5684: sub devalidate_domconfig_cache {
                   5685:     my ($udom)=@_;
                   5686:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5687: }
                   5688: 
                   5689: # ---------------------- Get domain configuration for a domain
                   5690: sub get_domainconf {
                   5691:     my ($udom) = @_;
                   5692:     my $cachetime=1800;
                   5693:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5694:     if (defined($cached)) { return %{$result}; }
                   5695: 
                   5696:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5697: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5698:     my (%designhash,%legacy);
1.518     albertel 5699:     if (keys(%domconfig) > 0) {
                   5700:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5701:             if (keys(%{$domconfig{'login'}})) {
                   5702:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5703:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87  raeburn  5704:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5705:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5706:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5707:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5708:                                         if ($key eq 'loginvia') {
                   5709:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5710:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5711:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5712:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5713:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5714:                                                 } else {
                   5715:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5716:                                                 }
1.948     raeburn  5717:                                             }
1.1075.2.87  raeburn  5718:                                         } elsif ($key eq 'headtag') {
                   5719:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5720:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5721:                                             }
1.946     raeburn  5722:                                         }
1.1075.2.87  raeburn  5723:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5724:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5725:                                         }
1.946     raeburn  5726:                                     }
                   5727:                                 }
                   5728:                             }
1.1075.2.158  raeburn  5729:                         } elsif ($key eq 'saml') {
                   5730:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5731:                                 foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
                   5732:                                     if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
                   5733:                                         $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1075.2.161.  .9(raebu 5734:22):                                         foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1075.2.158  raeburn  5735:                                             $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
                   5736:                                         }
                   5737:                                     }
                   5738:                                 }
                   5739:                             }
1.946     raeburn  5740:                         } else {
                   5741:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5742:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5743:                                     $domconfig{'login'}{$key}{$img};
                   5744:                             }
1.699     raeburn  5745:                         }
                   5746:                     } else {
                   5747:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5748:                     }
1.632     raeburn  5749:                 }
                   5750:             } else {
                   5751:                 $legacy{'login'} = 1;
1.518     albertel 5752:             }
1.632     raeburn  5753:         } else {
                   5754:             $legacy{'login'} = 1;
1.518     albertel 5755:         }
                   5756:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5757:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5758:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5759:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5760:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5761:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5762:                         }
1.518     albertel 5763:                     }
                   5764:                 }
1.632     raeburn  5765:             } else {
                   5766:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5767:             }
1.632     raeburn  5768:         } else {
                   5769:             $legacy{'rolecolors'} = 1;
1.518     albertel 5770:         }
1.948     raeburn  5771:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5772:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5773:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5774:             }
                   5775:         }
1.632     raeburn  5776:         if (keys(%legacy) > 0) {
                   5777:             my %legacyhash = &get_legacy_domconf($udom);
                   5778:             foreach my $item (keys(%legacyhash)) {
                   5779:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5780:                     if ($legacy{'login'}) { 
                   5781:                         $designhash{$item} = $legacyhash{$item};
                   5782:                     }
                   5783:                 } else {
                   5784:                     if ($legacy{'rolecolors'}) {
                   5785:                         $designhash{$item} = $legacyhash{$item};
                   5786:                     }
1.518     albertel 5787:                 }
                   5788:             }
                   5789:         }
1.632     raeburn  5790:     } else {
                   5791:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5792:     }
                   5793:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5794: 				  $cachetime);
                   5795:     return %designhash;
                   5796: }
                   5797: 
1.632     raeburn  5798: sub get_legacy_domconf {
                   5799:     my ($udom) = @_;
                   5800:     my %legacyhash;
                   5801:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5802:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5803:     if (-e $designfile) {
1.1075.2.128  raeburn  5804:         if ( open (my $fh,'<',$designfile) ) {
1.632     raeburn  5805:             while (my $line = <$fh>) {
                   5806:                 next if ($line =~ /^\#/);
                   5807:                 chomp($line);
                   5808:                 my ($key,$val)=(split(/\=/,$line));
                   5809:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5810:             }
                   5811:             close($fh);
                   5812:         }
                   5813:     }
1.1026    raeburn  5814:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5815:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5816:     }
                   5817:     return %legacyhash;
                   5818: }
                   5819: 
1.63      www      5820: =pod
                   5821: 
1.112     bowersj2 5822: =item * &domainlogo()
1.63      www      5823: 
                   5824: Inputs: $domain (usually will be undef)
                   5825: 
                   5826: Returns: A link to a domain logo, if the domain logo exists.
                   5827: If the domain logo does not exist, a description of the domain.
                   5828: 
                   5829: =cut
1.112     bowersj2 5830: 
1.63      www      5831: ###############################################
                   5832: sub domainlogo {
1.517     raeburn  5833:     my $domain = &determinedomain(shift);
1.518     albertel 5834:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5835:     # See if there is a logo
                   5836:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5837:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5838:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5839: 	    if ($imgsrc =~ m{^/res/}) {
                   5840: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5841: 		&Apache::lonnet::repcopy($local_name);
                   5842: 	    }
                   5843: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.1075.2.161.  .2(raebu 5844:22):         }
                   5845:22):         my $alttext = $domain;
                   5846:22):         if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
                   5847:22):             $alttext = $designhash{$domain.'.login.alttext_domlogo'};
                   5848:22):         }
                   5849:22):         return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514     albertel 5850:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5851:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5852:     } else {
1.60      matthew  5853:         return '';
1.59      www      5854:     }
                   5855: }
1.63      www      5856: ##############################################
                   5857: 
                   5858: =pod
                   5859: 
1.112     bowersj2 5860: =item * &designparm()
1.63      www      5861: 
                   5862: Inputs: $which parameter; $domain (usually will be undef)
                   5863: 
                   5864: Returns: value of designparamter $which
                   5865: 
                   5866: =cut
1.112     bowersj2 5867: 
1.397     albertel 5868: 
1.400     albertel 5869: ##############################################
1.397     albertel 5870: sub designparm {
                   5871:     my ($which,$domain)=@_;
                   5872:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5873:         return $env{'environment.color.'.$which};
1.96      www      5874:     }
1.63      www      5875:     $domain=&determinedomain($domain);
1.1016    raeburn  5876:     my %domdesign;
                   5877:     unless ($domain eq 'public') {
                   5878:         %domdesign = &get_domainconf($domain);
                   5879:     }
1.520     raeburn  5880:     my $output;
1.517     raeburn  5881:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5882:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5883:     } else {
1.520     raeburn  5884:         $output = $defaultdesign{$which};
                   5885:     }
                   5886:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5887:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5888:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5889:             if ($output =~ m{^/res/}) {
                   5890:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5891:                 &Apache::lonnet::repcopy($local_name);
                   5892:             }
1.520     raeburn  5893:             $output = &lonhttpdurl($output);
                   5894:         }
1.63      www      5895:     }
1.520     raeburn  5896:     return $output;
1.63      www      5897: }
1.59      www      5898: 
1.822     bisitz   5899: ##############################################
                   5900: =pod
                   5901: 
1.832     bisitz   5902: =item * &authorspace()
                   5903: 
1.1028    raeburn  5904: Inputs: $url (usually will be undef).
1.832     bisitz   5905: 
1.1075.2.40  raeburn  5906: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5907:          directory being viewed (or for which action is being taken). 
                   5908:          If $url is provided, and begins /priv/<domain>/<uname>
                   5909:          the path will be that portion of the $context argument.
                   5910:          Otherwise the path will be for the author space of the current
                   5911:          user when the current role is author, or for that of the 
                   5912:          co-author/assistant co-author space when the current role 
                   5913:          is co-author or assistant co-author.
1.832     bisitz   5914: 
                   5915: =cut
                   5916: 
                   5917: sub authorspace {
1.1028    raeburn  5918:     my ($url) = @_;
                   5919:     if ($url ne '') {
                   5920:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5921:            return $1;
                   5922:         }
                   5923:     }
1.832     bisitz   5924:     my $caname = '';
1.1024    www      5925:     my $cadom = '';
1.1028    raeburn  5926:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5927:         ($cadom,$caname) =
1.832     bisitz   5928:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5929:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5930:         $caname = $env{'user.name'};
1.1024    www      5931:         $cadom = $env{'user.domain'};
1.832     bisitz   5932:     }
1.1028    raeburn  5933:     if (($caname ne '') && ($cadom ne '')) {
                   5934:         return "/priv/$cadom/$caname/";
                   5935:     }
                   5936:     return;
1.832     bisitz   5937: }
                   5938: 
                   5939: ##############################################
                   5940: =pod
                   5941: 
1.822     bisitz   5942: =item * &head_subbox()
                   5943: 
                   5944: Inputs: $content (contains HTML code with page functions, etc.)
                   5945: 
                   5946: Returns: HTML div with $content
                   5947:          To be included in page header
                   5948: 
                   5949: =cut
                   5950: 
                   5951: sub head_subbox {
                   5952:     my ($content)=@_;
                   5953:     my $output =
1.993     raeburn  5954:         '<div class="LC_head_subbox">'
1.822     bisitz   5955:        .$content
                   5956:        .'</div>'
                   5957: }
                   5958: 
                   5959: ##############################################
                   5960: =pod
                   5961: 
                   5962: =item * &CSTR_pageheader()
                   5963: 
1.1026    raeburn  5964: Input: (optional) filename from which breadcrumb trail is built.
                   5965:        In most cases no input as needed, as $env{'request.filename'}
                   5966:        is appropriate for use in building the breadcrumb trail.
1.1075.2.161.  .6(raebu 5967:22):        frameset flag
                   5968:22):        If page header is being requested for use in a frameset, then
                   5969:22):        the second (option) argument -- frameset will be true, and
                   5970:22):        the target attribute set for links should be target="_parent".
1.822     bisitz   5971: 
                   5972: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  5973:          To be included on Authoring Space pages
1.822     bisitz   5974: 
                   5975: =cut
                   5976: 
                   5977: sub CSTR_pageheader {
1.1075.2.161.  .6(raebu 5978:22):     my ($trailfile,$frameset) = @_;
1.1026    raeburn  5979:     if ($trailfile eq '') {
                   5980:         $trailfile = $env{'request.filename'};
                   5981:     }
                   5982: 
                   5983: # this is for resources; directories have customtitle, and crumbs
                   5984: # and select recent are created in lonpubdir.pm
                   5985: 
                   5986:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5987:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  5988:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5989:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5990:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5991: 
                   5992:     my $parentpath = '';
                   5993:     my $lastitem = '';
                   5994:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5995:         $parentpath = $1;
                   5996:         $lastitem = $2;
                   5997:     } else {
                   5998:         $lastitem = $thisdisfn;
                   5999:     }
1.921     bisitz   6000: 
1.1075.2.161.  .6(raebu 6001:22):     my ($target,$crumbtarget) = (' target="_top"','_top');
                   6002:22):     if ($frameset) {
                   6003:22):         $target = ' target="_parent"';
                   6004:22):         $crumbtarget = '_parent';
          .17(raeb 6005:-23):     } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
                   6006:-23):         $target = '';
                   6007:-23):         $crumbtarget = '';
          .6(raebu 6008:22):     } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
                   6009:22):         $target = ' target="'.$env{'request.deeplink.target'}.'"';
                   6010:22):         $crumbtarget = $env{'request.deeplink.target'};
                   6011:22):     }
                   6012:22): 
1.921     bisitz   6013:     my $output =
1.822     bisitz   6014:          '<div>'
                   6015:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  6016:         .'<b>'.&mt('Authoring Space:').'</b> '
1.1075.2.161.  .6(raebu 6017:22):         .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
                   6018:22):         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921     bisitz   6019: 
                   6020:     if ($lastitem) {
                   6021:         $output .=
                   6022:              '<span class="LC_filename">'
                   6023:             .$lastitem
                   6024:             .'</span>';
                   6025:     }
                   6026:     $output .=
                   6027:          '<br />'
1.1075.2.161.  .6(raebu 6028:22):         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.822     bisitz   6029:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   6030:         .'</form>'
1.1075.2.161.  .6(raebu 6031:22):         .&Apache::lonmenu::constspaceform($frameset)
1.822     bisitz   6032:         .'</div>';
1.921     bisitz   6033: 
                   6034:     return $output;
1.822     bisitz   6035: }
                   6036: 
1.1075.2.161.  .21(raeb 6037:-24): ##############################################
                   6038:-24): =pod
                   6039:-24): 
                   6040:-24): =item * &nocodemirror()
                   6041:-24): 
                   6042:-24): Input: None
                   6043:-24): 
                   6044:-24): Returns: 1 if CodeMirror is deactivated based on
                   6045:-24):          user's preference, or domain default,
                   6046:-24):          if user indicated use of default.
                   6047:-24): 
                   6048:-24): =cut
                   6049:-24): 
                   6050:-24): sub nocodemirror {
                   6051:-24):     my $nocodem = $env{'environment.nocodemirror'};
                   6052:-24):     unless ($nocodem) {
                   6053:-24):         my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   6054:-24):         if ($domdefs{'nocodemirror'}) {
                   6055:-24):             $nocodem = 'yes';
                   6056:-24):         }
                   6057:-24):     }
                   6058:-24):     if ($nocodem eq 'yes') {
                   6059:-24):         return 1;
                   6060:-24):     }
                   6061:-24):     return;
                   6062:-24): }
                   6063:-24): 
                   6064:-24): ##############################################
                   6065:-24): =pod
                   6066:-24): 
                   6067:-24): =item * &permitted_editors()
                   6068:-24): 
                   6069:-24): Input: $uri (optional)
                   6070:-24): 
                   6071:-24): Returns: %editors hash in which keys are editors
                   6072:-24):          permitted in current Authoring Space.
                   6073:-24):          Value for each key is 1. Possible keys
                   6074:-24):          are: edit, xml, and daxe. If no specific
                   6075:-24):          set of editors has been set for the Author
                   6076:-24):          who owns the Authoring Space, then the
                   6077:-24):          domain default will be used.  If no domain
                   6078:-24):          default has been set, then the keys will be
                   6079:-24):          edit and xml.
                   6080:-24): 
                   6081:-24): =cut
                   6082:-24): 
                   6083:-24): sub permitted_editors {
                   6084:-24):     my ($uri) = @_;
                   6085:-24):     my ($is_author,$is_coauthor,$auname,$audom,%editors);
                   6086:-24):     if ($env{'request.role'} =~ m{^au\./}) {
                   6087:-24):         $is_author = 1;
                   6088:-24):     } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) {
                   6089:-24):         ($audom,$auname) = ($1,$2);
                   6090:-24):         if (($audom ne '') && ($auname ne '')) {
                   6091:-24):             if (($env{'user.domain'} eq $audom) &&
                   6092:-24):                 ($env{'user.name'} eq $auname)) {
                   6093:-24):                 $is_author = 1;
                   6094:-24):             } else {
                   6095:-24):                 $is_coauthor = 1;
                   6096:-24):             }
                   6097:-24):         }
                   6098:-24):     } elsif ($env{'request.course.id'}) {
                   6099:-24):         if ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) {
                   6100:-24):             ($audom,$auname) = ($1,$2);
                   6101:-24):         } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) {
                   6102:-24):             ($audom,$auname) = ($1,$2);
                   6103:-24):         } elsif (($uri eq '/daxesave') &&
                   6104:-24):                  ($env{'form.path'} =~ m{^/daxeopen/priv/($match_domain)/($match_username)/})) {
                   6105:-24):             ($audom,$auname) = ($1,$2);
                   6106:-24):         }
                   6107:-24):         if (($audom ne '') && ($auname ne '')) {
                   6108:-24):             if (($env{'user.domain'} eq $audom) &&
                   6109:-24):                 ($env{'user.name'} eq $auname)) {
                   6110:-24):                 $is_author = 1;
                   6111:-24):             } else {
                   6112:-24):                 $is_coauthor = 1;
                   6113:-24):             }
                   6114:-24):         }
                   6115:-24):     }
                   6116:-24):     if ($is_author) {
                   6117:-24):         if (exists($env{'environment.editors'})) {
                   6118:-24):             map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'});
                   6119:-24):         } else {
                   6120:-24):             %editors = ( edit => 1,
                   6121:-24):                          xml => 1,
                   6122:-24):                        );
                   6123:-24):         }
                   6124:-24):     } elsif ($is_coauthor) {
                   6125:-24):         if (exists($env{"environment.internal.editors./$audom/$auname"})) {
                   6126:-24):             map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"});
                   6127:-24):         } else {
                   6128:-24):             %editors = ( edit => 1,
                   6129:-24):                          xml => 1,
                   6130:-24):                        );
                   6131:-24):         }
                   6132:-24):     } else {
                   6133:-24):         %editors = ( edit => 1,
                   6134:-24):                      xml => 1,
                   6135:-24):                    );
                   6136:-24):     }
                   6137:-24):     return %editors;
                   6138:-24): }
                   6139:-24): 
1.60      matthew  6140: ###############################################
                   6141: ###############################################
                   6142: 
                   6143: =pod
                   6144: 
1.112     bowersj2 6145: =back
                   6146: 
1.549     albertel 6147: =head1 HTML Helpers
1.112     bowersj2 6148: 
                   6149: =over 4
                   6150: 
                   6151: =item * &bodytag()
1.60      matthew  6152: 
                   6153: Returns a uniform header for LON-CAPA web pages.
                   6154: 
                   6155: Inputs: 
                   6156: 
1.112     bowersj2 6157: =over 4
                   6158: 
                   6159: =item * $title, A title to be displayed on the page.
                   6160: 
                   6161: =item * $function, the current role (can be undef).
                   6162: 
                   6163: =item * $addentries, extra parameters for the <body> tag.
                   6164: 
                   6165: =item * $bodyonly, if defined, only return the <body> tag.
                   6166: 
                   6167: =item * $domain, if defined, force a given domain.
                   6168: 
                   6169: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      6170:             text interface only)
1.60      matthew  6171: 
1.814     bisitz   6172: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   6173:                      navigational links
1.317     albertel 6174: 
1.338     albertel 6175: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   6176: 
1.1075.2.12  raeburn  6177: =item * $no_inline_link, if true and in remote mode, don't show the
                   6178:          'Switch To Inline Menu' link
                   6179: 
1.460     albertel 6180: =item * $args, optional argument valid values are
                   6181:             no_auto_mt_title -> prevents &mt()ing the title arg
1.1075.2.133  raeburn  6182:             use_absolute     -> for external resource or syllabus, this will
                   6183:                                 contain https://<hostname> if server uses
                   6184:                                 https (as per hosts.tab), but request is for http
                   6185:             hostname         -> hostname, from $r->hostname().
1.460     albertel 6186: 
1.1075.2.15  raeburn  6187: =item * $advtoolsref, optional argument, ref to an array containing
                   6188:             inlineremote items to be added in "Functions" menu below
                   6189:             breadcrumbs.
                   6190: 
1.1075.2.161.  .1(raebu 6191:21): =item * $ltiscope, optional argument, will be one of: resource, map or
                   6192:21):             course, if LON-CAPA is in LTI Provider context. Value is
                   6193:21):             the scope of use, i.e., launch was for access to a single, a map
                   6194:21):             or the entire course.
                   6195:21): 
                   6196:21): =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
                   6197:21):             context, this will contain the URL for the landing item in
                   6198:21):             the course, after launch from an LTI Consumer
                   6199:21): 
                   6200:21): =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
                   6201:21):             context, this will contain a reference to hash of items
                   6202:21):             to be included in the page header and/or inline menu.
                   6203:21): 
          .8(raebu 6204:22): =item * $menucoll, optional argument, if specific menu collection is in
                   6205:22):             effect, either set as the default for the course, or set for
                   6206:22):             the deeplink paramater for $env{'request.deeplink.login'}
                   6207:22):             then $menucoll will be the number of that collection.
                   6208:22): 
                   6209:22): =item * $menuref, optional argument, reference to a hash, containing the
                   6210:22):             menu options included for the menu in effect, based on the
                   6211:22):             configuration for the numbered menu collection in use.
                   6212:22): 
                   6213:22): =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
                   6214:22):             within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
                   6215:22):             if so, $showncrumbsref is set there to 1, and will propagate back
                   6216:22):             via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
                   6217:22):             being called a second time.
                   6218:22): 
1.112     bowersj2 6219: =back
                   6220: 
1.60      matthew  6221: Returns: A uniform header for LON-CAPA web pages.  
                   6222: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   6223: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   6224: other decorations will be returned.
                   6225: 
                   6226: =cut
                   6227: 
1.54      www      6228: sub bodytag {
1.831     bisitz   6229:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.161.  .1(raebu 6230:21):         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref,
          .8(raebu 6231:22):         $ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339     albertel 6232: 
1.954     raeburn  6233:     my $public;
                   6234:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   6235:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   6236:         $public = 1;
                   6237:     }
1.460     albertel 6238:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  6239:     my $httphost = $args->{'use_absolute'};
1.1075.2.133  raeburn  6240:     my $hostname = $args->{'hostname'};
1.339     albertel 6241: 
1.183     matthew  6242:     $function = &get_users_function() if (!$function);
1.339     albertel 6243:     my $img =    &designparm($function.'.img',$domain);
                   6244:     my $font =   &designparm($function.'.font',$domain);
                   6245:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   6246: 
1.803     bisitz   6247:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 6248: 		   'bgcolor' => $pgbg,
1.339     albertel 6249: 		   'text'    => $font,
                   6250:                    'alink'   => &designparm($function.'.alink',$domain),
                   6251: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   6252: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 6253:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 6254: 
1.63      www      6255:  # role and realm
1.1075.2.68  raeburn  6256:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   6257:     if ($realm) {
                   6258:         $realm = '/'.$realm;
                   6259:     }
1.1075.2.159  raeburn  6260:     if ($role eq 'ca') {
1.479     albertel 6261:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 6262:         $realm = &plainname($rname,$rdom);
1.378     raeburn  6263:     } 
1.55      www      6264: # realm
1.1075.2.158  raeburn  6265:     my ($cid,$sec);
1.258     albertel 6266:     if ($env{'request.course.id'}) {
1.1075.2.158  raeburn  6267:         $cid = $env{'request.course.id'};
                   6268:         if ($env{'request.course.sec'}) {
                   6269:             $sec = $env{'request.course.sec'};
                   6270:         }
                   6271:     } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
                   6272:         if (&Apache::lonnet::is_course($1,$2)) {
                   6273:             $cid = $1.'_'.$2;
                   6274:             $sec = $3;
                   6275:         }
                   6276:     }
                   6277:     if ($cid) {
1.378     raeburn  6278:         if ($env{'request.role'} !~ /^cr/) {
                   6279:             $role = &Apache::lonnet::plaintext($role,&course_type());
1.1075.2.115  raeburn  6280:         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1075.2.121  raeburn  6281:             if ($env{'request.role.desc'}) {
                   6282:                 $role = $env{'request.role.desc'};
                   6283:             } else {
                   6284:                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
                   6285:             }
1.1075.2.115  raeburn  6286:         } else {
                   6287:             $role = (split(/\//,$role,4))[-1];
1.378     raeburn  6288:         }
1.1075.2.158  raeburn  6289:         if ($sec) {
                   6290:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$sec;
1.898     raeburn  6291:         }   
1.1075.2.158  raeburn  6292: 	$realm = $env{'course.'.$cid.'.description'};
1.378     raeburn  6293:     } else {
                   6294:         $role = &Apache::lonnet::plaintext($role);
1.54      www      6295:     }
1.433     albertel 6296: 
1.359     albertel 6297:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 6298: 
1.438     albertel 6299:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 6300: 
1.101     www      6301: # construct main body tag
1.359     albertel 6302:     my $bodytag = "<body $extra_body_attr>".
1.1075.2.100  raeburn  6303: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 6304: 
1.1075.2.38  raeburn  6305:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   6306: 
                   6307:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  6308:         return $bodytag;
1.1075.2.38  raeburn  6309:     }
1.359     albertel 6310: 
1.954     raeburn  6311:     if ($public) {
1.433     albertel 6312: 	undef($role);
                   6313:     }
1.1075.2.158  raeburn  6314: 
1.1075.2.161.  .1(raebu 6315:21):     my $showcrstitle = 1;
                   6316:21):     if (($cid) && ($env{'request.lti.login'})) {
                   6317:21):         if (ref($ltimenu) eq 'HASH') {
                   6318:21):             unless ($ltimenu->{'role'}) {
                   6319:21):                 undef($role);
                   6320:21):             }
                   6321:21):             unless ($ltimenu->{'coursetitle'}) {
                   6322:21):                 $realm='&nbsp;';
                   6323:21):                 $showcrstitle = 0;
                   6324:21):             }
                   6325:21):         }
                   6326:21):     } elsif (($cid) && ($menucoll)) {
                   6327:21):         if (ref($menuref) eq 'HASH') {
                   6328:21):             unless ($menuref->{'role'}) {
                   6329:21):                 undef($role);
                   6330:21):             }
                   6331:21):             unless ($menuref->{'crs'}) {
                   6332:21):                 $realm='&nbsp;';
                   6333:21):                 $showcrstitle = 0;
                   6334:21):             }
                   6335:21):         }
                   6336:21):     }
                   6337:21): 
1.762     bisitz   6338:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 6339:     #
                   6340:     # Extra info if you are the DC
                   6341:     my $dc_info = '';
1.1075.2.161.  .1(raebu 6342:21):     if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1075.2.158  raeburn  6343:         (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917     raeburn  6344:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      6345:         $dc_info =~ s/\s+$//;
1.359     albertel 6346:     }
                   6347: 
1.1075.2.161.  .1(raebu 6348:21):     my $crstype;
                   6349:21):     if ($cid) {
                   6350:21):         $crstype = $env{'course.'.$cid.'.type'};
                   6351:21):     } elsif ($args->{'crstype'}) {
                   6352:21):         $crstype = $args->{'crstype'};
                   6353:21):     }
                   6354:21): 
1.1075.2.108  raeburn  6355:     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.903     droeschl 6356: 
1.1075.2.13  raeburn  6357:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   6358: 
1.1075.2.38  raeburn  6359: 
                   6360: 
1.1075.2.21  raeburn  6361:     my $funclist;
                   6362:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  6363:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  6364:                     Apache::lonmenu::serverform();
                   6365:         my $forbodytag;
                   6366:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   6367:                                             $forcereg,$args->{'group'},
                   6368:                                             $args->{'bread_crumbs'},
1.1075.2.133  raeburn  6369:                                             $advtoolsref,'','',\$forbodytag);
1.1075.2.21  raeburn  6370:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   6371:             $funclist = $forbodytag;
                   6372:         }
                   6373:     } else {
1.903     droeschl 6374: 
                   6375:         #    if ($env{'request.state'} eq 'construct') {
                   6376:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   6377:         #    }
                   6378: 
1.1075.2.38  raeburn  6379:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  6380:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 6381: 
1.1075.2.161.  .21(raeb 6382:-24):         if ($args->{'collapsible_header'} ne '') {
                   6383:-24):             my $alttext = &mt('menu state: collapsed');
                   6384:-24):             my $tooltip = &mt('display standard menus');
                   6385:-24):             $bodytag .= <<"END";
                   6386:-24): <div id="LC_expandingContainer" style="display:inline;">
                   6387:-24): <div id="LC_collapsible" class="LC_collapse_trigger" style="position: absolute;top: -5px;left: 0px; z-index:101; display:inline;">
                   6388:-24): <a href="#" style="text-decoration:none;"><img class="LC_collapsible_indicator" alt="$alttext" title="$tooltip" src="/res/adm/pages/collapsed.png" style="border:0;margin:0;padding:0;max-width:100%;height:auto" /></a></div>
                   6389:-24): <div class="LC_menus_content hidden">
                   6390:-24): END
                   6391:-24):         }
          .1(raebu 6392:21):         unless ($args->{'no_primary_menu'}) {
          .4(raebu 6393:22):             my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
          .6(raebu 6394:22):                                                               $args->{'links_disabled'},
          .21(raeb 6395:-24):                                                               $args->{'links_target'},
                   6396:-24):                                                               $args->{'collapsible_header'});
          .1(raebu 6397:21):             if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
                   6398:21):                 if ($dc_info) {
                   6399:21):                     $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   6400:21):                 }
                   6401:21):                 $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
                   6402:21):                                <em>$realm</em> $dc_info</div>|;
                   6403:21):                 return $bodytag;
1.1075.2.1  raeburn  6404:             }
1.894     droeschl 6405: 
1.1075.2.161.  .1(raebu 6406:21):             unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   6407:21):                 $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
                   6408:21):             }
1.916     droeschl 6409: 
1.1075.2.161.  .1(raebu 6410:21):             $bodytag .= $right;
1.852     droeschl 6411: 
1.1075.2.161.  .1(raebu 6412:21):             if ($dc_info) {
                   6413:21):                 $dc_info = &dc_courseid_toggle($dc_info);
                   6414:21):             }
                   6415:21):             $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917     raeburn  6416:         }
1.916     droeschl 6417: 
1.1075.2.61  raeburn  6418:         #if directed to not display the secondary menu, don't.
                   6419:         if ($args->{'no_secondary_menu'}) {
                   6420:             return $bodytag;
                   6421:         }
1.903     droeschl 6422:         #don't show menus for public users
1.954     raeburn  6423:         if (!$public){
1.1075.2.161.  .1(raebu 6424:21):             unless ($args->{'no_inline_menu'}) {
                   6425:21):                 $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
                   6426:21):                                                             $args->{'no_primary_menu'},
                   6427:21):                                                             $menucoll,$menuref,
          .6(raebu 6428:22):                                                             $args->{'links_disabled'},
                   6429:22):                                                             $args->{'links_target'});
          .1(raebu 6430:21):             }
1.903     droeschl 6431:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  6432:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   6433:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 6434:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1075.2.161.  .8(raebu 6435:22):                                 $args->{'bread_crumbs'},'','',$hostname,
                   6436:22):                                 $ltiscope,$ltiuri,$showncrumbsref);
1.1075.2.116  raeburn  6437:             } elsif ($forcereg) {
1.1075.2.22  raeburn  6438:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1075.2.161.  .8(raebu 6439:22):                                 $args->{'group'},$args->{'hide_buttons'},
                   6440:22):                                 $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1075.2.15  raeburn  6441:             } else {
1.1075.2.21  raeburn  6442:                 my $forbodytag;
                   6443:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   6444:                                                     $forcereg,$args->{'group'},
                   6445:                                                     $args->{'bread_crumbs'},
1.1075.2.133  raeburn  6446:                                                     $advtoolsref,'',$hostname,
                   6447:                                                     \$forbodytag);
1.1075.2.21  raeburn  6448:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   6449:                     $bodytag .= $forbodytag;
                   6450:                 }
1.920     raeburn  6451:             }
1.903     droeschl 6452:         }else{
                   6453:             # this is to seperate menu from content when there's no secondary
                   6454:             # menu. Especially needed for public accessible ressources.
                   6455:             $bodytag .= '<hr style="clear:both" />';
                   6456:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  6457:         }
1.1075.2.161.  .21(raeb 6458:-24):         if ($args->{'collapsible_header'} ne '') {
                   6459:-24):             $bodytag .= $args->{'collapsible_header'}.
                   6460:-24):                         '<div id="LC_collapsible_separator"></div>'.
                   6461:-24):                         '</div></div>';
                   6462:-24):         }
1.235     raeburn  6463:         return $bodytag;
1.1075.2.12  raeburn  6464:     }
                   6465: 
                   6466: #
                   6467: # Top frame rendering, Remote is up
                   6468: #
                   6469: 
                   6470:     my $imgsrc = $img;
                   6471:     if ($img =~ /^\/adm/) {
                   6472:         $imgsrc = &lonhttpdurl($img);
                   6473:     }
                   6474:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   6475: 
1.1075.2.60  raeburn  6476:     my $help=($no_inline_link?''
                   6477:               :&Apache::loncommon::top_nav_help('Help'));
                   6478: 
1.1075.2.12  raeburn  6479:     # Explicit link to get inline menu
                   6480:     my $menu= ($no_inline_link?''
                   6481:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   6482: 
                   6483:     if ($dc_info) {
                   6484:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   6485:     }
                   6486: 
1.1075.2.38  raeburn  6487:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   6488:     unless ($public) {
                   6489:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   6490:                                 undef,'LC_menubuttons_link');
                   6491:     }
                   6492: 
1.1075.2.12  raeburn  6493:     unless ($env{'form.inhibitmenu'}) {
                   6494:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  6495:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  6496:                        <li>$help</li>
1.1075.2.12  raeburn  6497:                        <li>$menu</li>
                   6498:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   6499:     }
1.1075.2.13  raeburn  6500:     if ($env{'request.state'} eq 'construct') {
                   6501:         if (!$public){
                   6502:             if ($env{'request.state'} eq 'construct') {
                   6503:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  6504:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  6505:                             &Apache::lonhtmlcommon::scripttag('','end').
                   6506:                             &Apache::lonmenu::innerregister($forcereg,
                   6507:                                                             $args->{'bread_crumbs'});
                   6508:             }
                   6509:         }
                   6510:     }
1.1075.2.21  raeburn  6511:     return $bodytag."\n".$funclist;
1.182     matthew  6512: }
                   6513: 
1.917     raeburn  6514: sub dc_courseid_toggle {
                   6515:     my ($dc_info) = @_;
1.980     raeburn  6516:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  6517:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  6518:            &mt('(More ...)').'</a></span>'.
                   6519:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   6520: }
                   6521: 
1.330     albertel 6522: sub make_attr_string {
                   6523:     my ($register,$attr_ref) = @_;
                   6524: 
                   6525:     if ($attr_ref && !ref($attr_ref)) {
                   6526: 	die("addentries Must be a hash ref ".
                   6527: 	    join(':',caller(1))." ".
                   6528: 	    join(':',caller(0))." ");
                   6529:     }
                   6530: 
                   6531:     if ($register) {
1.339     albertel 6532: 	my ($on_load,$on_unload);
                   6533: 	foreach my $key (keys(%{$attr_ref})) {
                   6534: 	    if      (lc($key) eq 'onload') {
                   6535: 		$on_load.=$attr_ref->{$key}.';';
                   6536: 		delete($attr_ref->{$key});
                   6537: 
                   6538: 	    } elsif (lc($key) eq 'onunload') {
                   6539: 		$on_unload.=$attr_ref->{$key}.';';
                   6540: 		delete($attr_ref->{$key});
                   6541: 	    }
                   6542: 	}
1.1075.2.12  raeburn  6543:         if ($env{'environment.remote'} eq 'on') {
                   6544:             $attr_ref->{'onload'}  =
                   6545:                 &Apache::lonmenu::loadevents().  $on_load;
                   6546:             $attr_ref->{'onunload'}=
                   6547:                 &Apache::lonmenu::unloadevents().$on_unload;
                   6548:         } else {  
                   6549: 	    $attr_ref->{'onload'}  = $on_load;
                   6550: 	    $attr_ref->{'onunload'}= $on_unload;
                   6551:         }
1.330     albertel 6552:     }
1.339     albertel 6553: 
1.330     albertel 6554:     my $attr_string;
1.1075.2.56  raeburn  6555:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 6556: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   6557:     }
                   6558:     return $attr_string;
                   6559: }
                   6560: 
                   6561: 
1.182     matthew  6562: ###############################################
1.251     albertel 6563: ###############################################
                   6564: 
                   6565: =pod
                   6566: 
                   6567: =item * &endbodytag()
                   6568: 
                   6569: Returns a uniform footer for LON-CAPA web pages.
                   6570: 
1.635     raeburn  6571: Inputs: 1 - optional reference to an args hash
                   6572: If in the hash, key for noredirectlink has a value which evaluates to true,
                   6573: a 'Continue' link is not displayed if the page contains an
                   6574: internal redirect in the <head></head> section,
                   6575: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 6576: 
                   6577: =cut
                   6578: 
                   6579: sub endbodytag {
1.635     raeburn  6580:     my ($args) = @_;
1.1075.2.6  raeburn  6581:     my $endbodytag;
                   6582:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   6583:         $endbodytag='</body>';
                   6584:     }
1.315     albertel 6585:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  6586:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1075.2.161.  .9(raebu 6587:22):             my ($endbodyjs,$idattr);
                   6588:22):             if ($env{'internal.head.to_opener'}) {
                   6589:22):                 my $linkid = 'LC_continue_link';
                   6590:22):                 $idattr = ' id="'.$linkid.'"';
                   6591:22):                 my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
                   6592:22):                 $endbodyjs=<<ENDJS;
                   6593:22): <script type="text/javascript">
                   6594:22): // <![CDATA[
                   6595:22): function ebFunction(evt) {
                   6596:22):     evt.preventDefault();
                   6597:22):     var dest = '$redirect_for_js';
                   6598:22):     if (window.opener != null && !window.opener.closed) {
                   6599:22):         window.opener.location.href=dest;
                   6600:22):         window.close();
                   6601:22):     } else {
                   6602:22):         window.location.href=dest;
                   6603:22):     }
                   6604:22):     return false;
                   6605:22): }
                   6606:22): 
                   6607:22): \$(document).ready(function () {
                   6608:22):   if (document.getElementById('$linkid')) {
                   6609:22):     var clickelem = document.getElementById('$linkid');
                   6610:22):     clickelem.addEventListener('click',ebFunction,false);
                   6611:22):   }
                   6612:22): });
                   6613:22): // ]]>
                   6614:22): </script>
                   6615:22): ENDJS
                   6616:22):             }
1.635     raeburn  6617: 	    $endbodytag=
1.1075.2.161.  .9(raebu 6618:22): 	        "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635     raeburn  6619: 	        &mt('Continue').'</a>'.
                   6620: 	        $endbodytag;
                   6621:         }
1.315     albertel 6622:     }
1.1075.2.161.  .19(raeb 6623:-23):     if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
                   6624:-23):         $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
                   6625:-23):     }
1.251     albertel 6626:     return $endbodytag;
                   6627: }
                   6628: 
1.352     albertel 6629: =pod
                   6630: 
                   6631: =item * &standard_css()
                   6632: 
                   6633: Returns a style sheet
                   6634: 
                   6635: Inputs: (all optional)
                   6636:             domain         -> force to color decorate a page for a specific
                   6637:                                domain
                   6638:             function       -> force usage of a specific rolish color scheme
                   6639:             bgcolor        -> override the default page bgcolor
                   6640: 
                   6641: =cut
                   6642: 
1.343     albertel 6643: sub standard_css {
1.345     albertel 6644:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 6645:     $function  = &get_users_function() if (!$function);
                   6646:     my $img    = &designparm($function.'.img',   $domain);
                   6647:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   6648:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 6649:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 6650: #second colour for later usage
1.345     albertel 6651:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 6652:     my $pgbg_or_bgcolor =
                   6653: 	         $bgcolor ||
1.352     albertel 6654: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 6655:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 6656:     my $alink  = &designparm($function.'.alink', $domain);
                   6657:     my $vlink  = &designparm($function.'.vlink', $domain);
                   6658:     my $link   = &designparm($function.'.link',  $domain);
                   6659: 
1.602     albertel 6660:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 6661:     my $mono                 = 'monospace';
1.850     bisitz   6662:     my $data_table_head      = $sidebg;
                   6663:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   6664:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 6665:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 6666:     my $data_table_highlight = '#FFFF00';
1.352     albertel 6667:     my $mail_new             = '#FFBB77';
                   6668:     my $mail_new_hover       = '#DD9955';
                   6669:     my $mail_read            = '#BBBB77';
                   6670:     my $mail_read_hover      = '#999944';
                   6671:     my $mail_replied         = '#AAAA88';
                   6672:     my $mail_replied_hover   = '#888855';
                   6673:     my $mail_other           = '#99BBBB';
                   6674:     my $mail_other_hover     = '#669999';
1.391     albertel 6675:     my $table_header         = '#DDDDDD';
1.489     raeburn  6676:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   6677:     my $lg_border_color      = '#C8C8C8';
1.952     onken    6678:     my $button_hover         = '#BF2317';
1.392     albertel 6679: 
1.608     albertel 6680:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   6681:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   6682:                                              : '0 3px 0 4px';
1.448     albertel 6683: 
1.523     albertel 6684: 
1.343     albertel 6685:     return <<END;
1.947     droeschl 6686: 
                   6687: /* needed for iframe to allow 100% height in FF */
                   6688: body, html { 
                   6689:     margin: 0;
                   6690:     padding: 0 0.5%;
                   6691:     height: 99%; /* to avoid scrollbars */
                   6692: }
                   6693: 
1.795     www      6694: body {
1.911     bisitz   6695:   font-family: $sans;
                   6696:   line-height:130%;
                   6697:   font-size:0.83em;
                   6698:   color:$font;
1.795     www      6699: }
                   6700: 
1.959     onken    6701: a:focus,
                   6702: a:focus img {
1.795     www      6703:   color: red;
                   6704: }
1.698     harmsja  6705: 
1.911     bisitz   6706: form, .inline {
                   6707:   display: inline;
1.795     www      6708: }
1.721     harmsja  6709: 
1.1075.2.161.  .21(raeb 6710:-24): .LC_menus_content.shown{
                   6711:-24):   display: inline;
                   6712:-24): }
                   6713:-24): 
                   6714:-24): .LC_menus_content.hidden {
                   6715:-24):   display: none;
                   6716:-24): }
                   6717:-24): 
1.795     www      6718: .LC_right {
1.911     bisitz   6719:   text-align:right;
1.795     www      6720: }
                   6721: 
                   6722: .LC_middle {
1.911     bisitz   6723:   vertical-align:middle;
1.795     www      6724: }
1.721     harmsja  6725: 
1.1075.2.38  raeburn  6726: .LC_floatleft {
                   6727:   float: left;
                   6728: }
                   6729: 
                   6730: .LC_floatright {
                   6731:   float: right;
                   6732: }
                   6733: 
1.911     bisitz   6734: .LC_400Box {
                   6735:   width:400px;
                   6736: }
1.721     harmsja  6737: 
1.1075.2.161.  .21(raeb 6738:-24): #LC_collapsible_separator {
                   6739:-24):     border: 1px solid black;
                   6740:-24):     width: 99.9%;
                   6741:-24):     height: 0px;
                   6742:-24): }
                   6743:-24): 
1.947     droeschl 6744: .LC_iframecontainer {
                   6745:     width: 98%;
                   6746:     margin: 0;
                   6747:     position: fixed;
                   6748:     top: 8.5em;
                   6749:     bottom: 0;
                   6750: }
                   6751: 
                   6752: .LC_iframecontainer iframe{
                   6753:     border: none;
                   6754:     width: 100%;
                   6755:     height: 100%;
                   6756: }
                   6757: 
1.778     bisitz   6758: .LC_filename {
                   6759:   font-family: $mono;
                   6760:   white-space:pre;
1.921     bisitz   6761:   font-size: 120%;
1.778     bisitz   6762: }
                   6763: 
                   6764: .LC_fileicon {
                   6765:   border: none;
                   6766:   height: 1.3em;
                   6767:   vertical-align: text-bottom;
                   6768:   margin-right: 0.3em;
                   6769:   text-decoration:none;
                   6770: }
                   6771: 
1.1008    www      6772: .LC_setting {
                   6773:   text-decoration:underline;
                   6774: }
                   6775: 
1.350     albertel 6776: .LC_error {
                   6777:   color: red;
                   6778: }
1.795     www      6779: 
1.1075.2.15  raeburn  6780: .LC_warning {
                   6781:   color: darkorange;
                   6782: }
                   6783: 
1.457     albertel 6784: .LC_diff_removed {
1.733     bisitz   6785:   color: red;
1.394     albertel 6786: }
1.532     albertel 6787: 
                   6788: .LC_info,
1.457     albertel 6789: .LC_success,
                   6790: .LC_diff_added {
1.350     albertel 6791:   color: green;
                   6792: }
1.795     www      6793: 
1.802     bisitz   6794: div.LC_confirm_box {
                   6795:   background-color: #FAFAFA;
                   6796:   border: 1px solid $lg_border_color;
                   6797:   margin-right: 0;
                   6798:   padding: 5px;
                   6799: }
                   6800: 
                   6801: div.LC_confirm_box .LC_error img,
                   6802: div.LC_confirm_box .LC_success img {
                   6803:   vertical-align: middle;
                   6804: }
                   6805: 
1.1075.2.108  raeburn  6806: .LC_maxwidth {
                   6807:   max-width: 100%;
                   6808:   height: auto;
                   6809: }
                   6810: 
                   6811: .LC_textsize_mobile {
                   6812:   \@media only screen and (max-device-width: 480px) {
                   6813:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   6814:   }
                   6815: }
                   6816: 
1.440     albertel 6817: .LC_icon {
1.771     droeschl 6818:   border: none;
1.790     droeschl 6819:   vertical-align: middle;
1.771     droeschl 6820: }
                   6821: 
1.543     albertel 6822: .LC_docs_spacer {
                   6823:   width: 25px;
                   6824:   height: 1px;
1.771     droeschl 6825:   border: none;
1.543     albertel 6826: }
1.346     albertel 6827: 
1.532     albertel 6828: .LC_internal_info {
1.735     bisitz   6829:   color: #999999;
1.532     albertel 6830: }
                   6831: 
1.794     www      6832: .LC_discussion {
1.1050    www      6833:   background: $data_table_dark;
1.911     bisitz   6834:   border: 1px solid black;
                   6835:   margin: 2px;
1.794     www      6836: }
                   6837: 
                   6838: .LC_disc_action_left {
1.1050    www      6839:   background: $sidebg;
1.911     bisitz   6840:   text-align: left;
1.1050    www      6841:   padding: 4px;
                   6842:   margin: 2px;
1.794     www      6843: }
                   6844: 
                   6845: .LC_disc_action_right {
1.1050    www      6846:   background: $sidebg;
1.911     bisitz   6847:   text-align: right;
1.1050    www      6848:   padding: 4px;
                   6849:   margin: 2px;
1.794     www      6850: }
                   6851: 
                   6852: .LC_disc_new_item {
1.911     bisitz   6853:   background: white;
                   6854:   border: 2px solid red;
1.1050    www      6855:   margin: 4px;
                   6856:   padding: 4px;
1.794     www      6857: }
                   6858: 
                   6859: .LC_disc_old_item {
1.911     bisitz   6860:   background: white;
1.1050    www      6861:   margin: 4px;
                   6862:   padding: 4px;
1.794     www      6863: }
                   6864: 
1.458     albertel 6865: table.LC_pastsubmission {
                   6866:   border: 1px solid black;
                   6867:   margin: 2px;
                   6868: }
                   6869: 
1.924     bisitz   6870: table#LC_menubuttons {
1.345     albertel 6871:   width: 100%;
                   6872:   background: $pgbg;
1.392     albertel 6873:   border: 2px;
1.402     albertel 6874:   border-collapse: separate;
1.803     bisitz   6875:   padding: 0;
1.345     albertel 6876: }
1.392     albertel 6877: 
1.801     tempelho 6878: table#LC_title_bar a {
                   6879:   color: $fontmenu;
                   6880: }
1.836     bisitz   6881: 
1.807     droeschl 6882: table#LC_title_bar {
1.819     tempelho 6883:   clear: both;
1.836     bisitz   6884:   display: none;
1.807     droeschl 6885: }
                   6886: 
1.795     www      6887: table#LC_title_bar,
1.933     droeschl 6888: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 6889: table#LC_title_bar.LC_with_remote {
1.359     albertel 6890:   width: 100%;
1.392     albertel 6891:   border-color: $pgbg;
                   6892:   border-style: solid;
                   6893:   border-width: $border;
1.379     albertel 6894:   background: $pgbg;
1.801     tempelho 6895:   color: $fontmenu;
1.392     albertel 6896:   border-collapse: collapse;
1.803     bisitz   6897:   padding: 0;
1.819     tempelho 6898:   margin: 0;
1.359     albertel 6899: }
1.795     www      6900: 
1.933     droeschl 6901: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 6902:     margin: 0;
                   6903:     padding: 0;
1.933     droeschl 6904:     position: relative;
                   6905:     list-style: none;
1.913     droeschl 6906: }
1.933     droeschl 6907: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 6908:     display: inline;
                   6909: }
1.933     droeschl 6910: 
                   6911: .LC_breadcrumb_tools_navigation {
1.913     droeschl 6912:     padding: 0;
1.933     droeschl 6913:     margin: 0;
                   6914:     float: left;
1.913     droeschl 6915: }
1.933     droeschl 6916: .LC_breadcrumb_tools_tools {
                   6917:     padding: 0;
                   6918:     margin: 0;
1.913     droeschl 6919:     float: right;
                   6920: }
                   6921: 
1.359     albertel 6922: table#LC_title_bar td {
                   6923:   background: $tabbg;
                   6924: }
1.795     www      6925: 
1.911     bisitz   6926: table#LC_menubuttons img {
1.803     bisitz   6927:   border: none;
1.346     albertel 6928: }
1.795     www      6929: 
1.842     droeschl 6930: .LC_breadcrumbs_component {
1.911     bisitz   6931:   float: right;
                   6932:   margin: 0 1em;
1.357     albertel 6933: }
1.842     droeschl 6934: .LC_breadcrumbs_component img {
1.911     bisitz   6935:   vertical-align: middle;
1.777     tempelho 6936: }
1.795     www      6937: 
1.1075.2.108  raeburn  6938: .LC_breadcrumbs_hoverable {
                   6939:   background: $sidebg;
                   6940: }
                   6941: 
1.383     albertel 6942: td.LC_table_cell_checkbox {
                   6943:   text-align: center;
                   6944: }
1.795     www      6945: 
                   6946: .LC_fontsize_small {
1.911     bisitz   6947:   font-size: 70%;
1.705     tempelho 6948: }
                   6949: 
1.844     bisitz   6950: #LC_breadcrumbs {
1.911     bisitz   6951:   clear:both;
                   6952:   background: $sidebg;
                   6953:   border-bottom: 1px solid $lg_border_color;
                   6954:   line-height: 2.5em;
1.933     droeschl 6955:   overflow: hidden;
1.911     bisitz   6956:   margin: 0;
                   6957:   padding: 0;
1.995     raeburn  6958:   text-align: left;
1.819     tempelho 6959: }
1.862     bisitz   6960: 
1.1075.2.16  raeburn  6961: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6962:   clear:both;
                   6963:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6964:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  6965:   margin: 0 0 10px 0;
1.966     bisitz   6966:   padding: 3px;
1.995     raeburn  6967:   text-align: left;
1.822     bisitz   6968: }
                   6969: 
1.795     www      6970: .LC_fontsize_medium {
1.911     bisitz   6971:   font-size: 85%;
1.705     tempelho 6972: }
                   6973: 
1.795     www      6974: .LC_fontsize_large {
1.911     bisitz   6975:   font-size: 120%;
1.705     tempelho 6976: }
                   6977: 
1.346     albertel 6978: .LC_menubuttons_inline_text {
                   6979:   color: $font;
1.698     harmsja  6980:   font-size: 90%;
1.701     harmsja  6981:   padding-left:3px;
1.346     albertel 6982: }
                   6983: 
1.934     droeschl 6984: .LC_menubuttons_inline_text img{
                   6985:   vertical-align: middle;
                   6986: }
                   6987: 
1.1051    www      6988: li.LC_menubuttons_inline_text img {
1.951     onken    6989:   cursor:pointer;
1.1002    droeschl 6990:   text-decoration: none;
1.951     onken    6991: }
                   6992: 
1.526     www      6993: .LC_menubuttons_link {
                   6994:   text-decoration: none;
                   6995: }
1.795     www      6996: 
1.522     albertel 6997: .LC_menubuttons_category {
1.521     www      6998:   color: $font;
1.526     www      6999:   background: $pgbg;
1.521     www      7000:   font-size: larger;
                   7001:   font-weight: bold;
                   7002: }
                   7003: 
1.346     albertel 7004: td.LC_menubuttons_text {
1.911     bisitz   7005:   color: $font;
1.346     albertel 7006: }
1.706     harmsja  7007: 
1.346     albertel 7008: .LC_current_location {
                   7009:   background: $tabbg;
                   7010: }
1.795     www      7011: 
1.1075.2.134  raeburn  7012: td.LC_zero_height {
                   7013:   line-height: 0;
                   7014:   cellpadding: 0;
                   7015: }
                   7016: 
1.938     bisitz   7017: table.LC_data_table {
1.347     albertel 7018:   border: 1px solid #000000;
1.402     albertel 7019:   border-collapse: separate;
1.426     albertel 7020:   border-spacing: 1px;
1.610     albertel 7021:   background: $pgbg;
1.347     albertel 7022: }
1.795     www      7023: 
1.422     albertel 7024: .LC_data_table_dense {
                   7025:   font-size: small;
                   7026: }
1.795     www      7027: 
1.507     raeburn  7028: table.LC_nested_outer {
                   7029:   border: 1px solid #000000;
1.589     raeburn  7030:   border-collapse: collapse;
1.803     bisitz   7031:   border-spacing: 0;
1.507     raeburn  7032:   width: 100%;
                   7033: }
1.795     www      7034: 
1.879     raeburn  7035: table.LC_innerpickbox,
1.507     raeburn  7036: table.LC_nested {
1.803     bisitz   7037:   border: none;
1.589     raeburn  7038:   border-collapse: collapse;
1.803     bisitz   7039:   border-spacing: 0;
1.507     raeburn  7040:   width: 100%;
                   7041: }
1.795     www      7042: 
1.911     bisitz   7043: table.LC_data_table tr th,
                   7044: table.LC_calendar tr th,
1.879     raeburn  7045: table.LC_prior_tries tr th,
                   7046: table.LC_innerpickbox tr th {
1.349     albertel 7047:   font-weight: bold;
                   7048:   background-color: $data_table_head;
1.801     tempelho 7049:   color:$fontmenu;
1.701     harmsja  7050:   font-size:90%;
1.347     albertel 7051: }
1.795     www      7052: 
1.879     raeburn  7053: table.LC_innerpickbox tr th,
                   7054: table.LC_innerpickbox tr td {
                   7055:   vertical-align: top;
                   7056: }
                   7057: 
1.711     raeburn  7058: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   7059:   background-color: #CCCCCC;
1.711     raeburn  7060:   font-weight: bold;
                   7061:   text-align: left;
                   7062: }
1.795     www      7063: 
1.912     bisitz   7064: table.LC_data_table tr.LC_odd_row > td {
                   7065:   background-color: $data_table_light;
                   7066:   padding: 2px;
                   7067:   vertical-align: top;
                   7068: }
                   7069: 
1.809     bisitz   7070: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 7071:   background-color: $data_table_light;
1.912     bisitz   7072:   vertical-align: top;
                   7073: }
                   7074: 
                   7075: table.LC_data_table tr.LC_even_row > td {
                   7076:   background-color: $data_table_dark;
1.425     albertel 7077:   padding: 2px;
1.900     bisitz   7078:   vertical-align: top;
1.347     albertel 7079: }
1.795     www      7080: 
1.809     bisitz   7081: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 7082:   background-color: $data_table_dark;
1.900     bisitz   7083:   vertical-align: top;
1.347     albertel 7084: }
1.795     www      7085: 
1.425     albertel 7086: table.LC_data_table tr.LC_data_table_highlight td {
                   7087:   background-color: $data_table_darker;
                   7088: }
1.795     www      7089: 
1.639     raeburn  7090: table.LC_data_table tr td.LC_leftcol_header {
                   7091:   background-color: $data_table_head;
                   7092:   font-weight: bold;
                   7093: }
1.795     www      7094: 
1.451     albertel 7095: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  7096: table.LC_nested tr.LC_empty_row td {
1.421     albertel 7097:   font-weight: bold;
                   7098:   font-style: italic;
                   7099:   text-align: center;
                   7100:   padding: 8px;
1.347     albertel 7101: }
1.795     www      7102: 
1.1075.2.30  raeburn  7103: table.LC_data_table tr.LC_empty_row td,
                   7104: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   7105:   background-color: $sidebg;
                   7106: }
                   7107: 
                   7108: table.LC_nested tr.LC_empty_row td {
                   7109:   background-color: #FFFFFF;
                   7110: }
                   7111: 
1.890     droeschl 7112: table.LC_caption {
                   7113: }
                   7114: 
1.507     raeburn  7115: table.LC_nested tr.LC_empty_row td {
1.465     albertel 7116:   padding: 4ex
                   7117: }
1.795     www      7118: 
1.507     raeburn  7119: table.LC_nested_outer tr th {
                   7120:   font-weight: bold;
1.801     tempelho 7121:   color:$fontmenu;
1.507     raeburn  7122:   background-color: $data_table_head;
1.701     harmsja  7123:   font-size: small;
1.507     raeburn  7124:   border-bottom: 1px solid #000000;
                   7125: }
1.795     www      7126: 
1.507     raeburn  7127: table.LC_nested_outer tr td.LC_subheader {
                   7128:   background-color: $data_table_head;
                   7129:   font-weight: bold;
                   7130:   font-size: small;
                   7131:   border-bottom: 1px solid #000000;
                   7132:   text-align: right;
1.451     albertel 7133: }
1.795     www      7134: 
1.507     raeburn  7135: table.LC_nested tr.LC_info_row td {
1.735     bisitz   7136:   background-color: #CCCCCC;
1.451     albertel 7137:   font-weight: bold;
                   7138:   font-size: small;
1.507     raeburn  7139:   text-align: center;
                   7140: }
1.795     www      7141: 
1.589     raeburn  7142: table.LC_nested tr.LC_info_row td.LC_left_item,
                   7143: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  7144:   text-align: left;
1.451     albertel 7145: }
1.795     www      7146: 
1.507     raeburn  7147: table.LC_nested td {
1.735     bisitz   7148:   background-color: #FFFFFF;
1.451     albertel 7149:   font-size: small;
1.507     raeburn  7150: }
1.795     www      7151: 
1.507     raeburn  7152: table.LC_nested_outer tr th.LC_right_item,
                   7153: table.LC_nested tr.LC_info_row td.LC_right_item,
                   7154: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   7155: table.LC_nested tr td.LC_right_item {
1.451     albertel 7156:   text-align: right;
                   7157: }
                   7158: 
1.507     raeburn  7159: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   7160:   background-color: #EEEEEE;
1.451     albertel 7161: }
                   7162: 
1.473     raeburn  7163: table.LC_createuser {
                   7164: }
                   7165: 
                   7166: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  7167:   font-size: small;
1.473     raeburn  7168: }
                   7169: 
                   7170: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   7171:   background-color: #CCCCCC;
1.473     raeburn  7172:   font-weight: bold;
                   7173:   text-align: center;
                   7174: }
                   7175: 
1.349     albertel 7176: table.LC_calendar {
                   7177:   border: 1px solid #000000;
                   7178:   border-collapse: collapse;
1.917     raeburn  7179:   width: 98%;
1.349     albertel 7180: }
1.795     www      7181: 
1.349     albertel 7182: table.LC_calendar_pickdate {
                   7183:   font-size: xx-small;
                   7184: }
1.795     www      7185: 
1.349     albertel 7186: table.LC_calendar tr td {
                   7187:   border: 1px solid #000000;
                   7188:   vertical-align: top;
1.917     raeburn  7189:   width: 14%;
1.349     albertel 7190: }
1.795     www      7191: 
1.349     albertel 7192: table.LC_calendar tr td.LC_calendar_day_empty {
                   7193:   background-color: $data_table_dark;
                   7194: }
1.795     www      7195: 
1.779     bisitz   7196: table.LC_calendar tr td.LC_calendar_day_current {
                   7197:   background-color: $data_table_highlight;
1.777     tempelho 7198: }
1.795     www      7199: 
1.938     bisitz   7200: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 7201:   background-color: $mail_new;
                   7202: }
1.795     www      7203: 
1.938     bisitz   7204: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 7205:   background-color: $mail_new_hover;
                   7206: }
1.795     www      7207: 
1.938     bisitz   7208: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 7209:   background-color: $mail_read;
                   7210: }
1.795     www      7211: 
1.938     bisitz   7212: /*
                   7213: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 7214:   background-color: $mail_read_hover;
                   7215: }
1.938     bisitz   7216: */
1.795     www      7217: 
1.938     bisitz   7218: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 7219:   background-color: $mail_replied;
                   7220: }
1.795     www      7221: 
1.938     bisitz   7222: /*
                   7223: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 7224:   background-color: $mail_replied_hover;
                   7225: }
1.938     bisitz   7226: */
1.795     www      7227: 
1.938     bisitz   7228: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 7229:   background-color: $mail_other;
                   7230: }
1.795     www      7231: 
1.938     bisitz   7232: /*
                   7233: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 7234:   background-color: $mail_other_hover;
                   7235: }
1.938     bisitz   7236: */
1.494     raeburn  7237: 
1.777     tempelho 7238: table.LC_data_table tr > td.LC_browser_file,
                   7239: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   7240:   background: #AAEE77;
1.389     albertel 7241: }
1.795     www      7242: 
1.777     tempelho 7243: table.LC_data_table tr > td.LC_browser_file_locked,
                   7244: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 7245:   background: #FFAA99;
1.387     albertel 7246: }
1.795     www      7247: 
1.777     tempelho 7248: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   7249:   background: #888888;
1.779     bisitz   7250: }
1.795     www      7251: 
1.777     tempelho 7252: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   7253: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   7254:   background: #F8F866;
1.777     tempelho 7255: }
1.795     www      7256: 
1.696     bisitz   7257: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   7258:   background: #E0E8FF;
1.387     albertel 7259: }
1.696     bisitz   7260: 
1.707     bisitz   7261: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   7262:   /* background: #77FF77; */
1.707     bisitz   7263: }
1.795     www      7264: 
1.707     bisitz   7265: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   7266:   border-right: 8px solid #FFFF77;
1.707     bisitz   7267: }
1.795     www      7268: 
1.707     bisitz   7269: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   7270:   border-right: 8px solid #FFAA77;
1.707     bisitz   7271: }
1.795     www      7272: 
1.707     bisitz   7273: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   7274:   border-right: 8px solid #FF7777;
1.707     bisitz   7275: }
1.795     www      7276: 
1.707     bisitz   7277: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   7278:   border-right: 8px solid #AAFF77;
1.707     bisitz   7279: }
1.795     www      7280: 
1.707     bisitz   7281: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   7282:   border-right: 8px solid #11CC55;
1.707     bisitz   7283: }
                   7284: 
1.388     albertel 7285: span.LC_current_location {
1.701     harmsja  7286:   font-size:larger;
1.388     albertel 7287:   background: $pgbg;
                   7288: }
1.387     albertel 7289: 
1.1029    www      7290: span.LC_current_nav_location {
                   7291:   font-weight:bold;
                   7292:   background: $sidebg;
                   7293: }
                   7294: 
1.395     albertel 7295: span.LC_parm_menu_item {
                   7296:   font-size: larger;
                   7297: }
1.795     www      7298: 
1.395     albertel 7299: span.LC_parm_scope_all {
                   7300:   color: red;
                   7301: }
1.795     www      7302: 
1.395     albertel 7303: span.LC_parm_scope_folder {
                   7304:   color: green;
                   7305: }
1.795     www      7306: 
1.395     albertel 7307: span.LC_parm_scope_resource {
                   7308:   color: orange;
                   7309: }
1.795     www      7310: 
1.395     albertel 7311: span.LC_parm_part {
                   7312:   color: blue;
                   7313: }
1.795     www      7314: 
1.911     bisitz   7315: span.LC_parm_folder,
                   7316: span.LC_parm_symb {
1.395     albertel 7317:   font-size: x-small;
                   7318:   font-family: $mono;
                   7319:   color: #AAAAAA;
                   7320: }
                   7321: 
1.977     bisitz   7322: ul.LC_parm_parmlist li {
                   7323:   display: inline-block;
                   7324:   padding: 0.3em 0.8em;
                   7325:   vertical-align: top;
                   7326:   width: 150px;
                   7327:   border-top:1px solid $lg_border_color;
                   7328: }
                   7329: 
1.795     www      7330: td.LC_parm_overview_level_menu,
                   7331: td.LC_parm_overview_map_menu,
                   7332: td.LC_parm_overview_parm_selectors,
                   7333: td.LC_parm_overview_restrictions  {
1.396     albertel 7334:   border: 1px solid black;
                   7335:   border-collapse: collapse;
                   7336: }
1.795     www      7337: 
1.396     albertel 7338: table.LC_parm_overview_restrictions td {
                   7339:   border-width: 1px 4px 1px 4px;
                   7340:   border-style: solid;
                   7341:   border-color: $pgbg;
                   7342:   text-align: center;
                   7343: }
1.795     www      7344: 
1.396     albertel 7345: table.LC_parm_overview_restrictions th {
                   7346:   background: $tabbg;
                   7347:   border-width: 1px 4px 1px 4px;
                   7348:   border-style: solid;
                   7349:   border-color: $pgbg;
                   7350: }
1.795     www      7351: 
1.398     albertel 7352: table#LC_helpmenu {
1.803     bisitz   7353:   border: none;
1.398     albertel 7354:   height: 55px;
1.803     bisitz   7355:   border-spacing: 0;
1.398     albertel 7356: }
                   7357: 
                   7358: table#LC_helpmenu fieldset legend {
                   7359:   font-size: larger;
                   7360: }
1.795     www      7361: 
1.397     albertel 7362: table#LC_helpmenu_links {
                   7363:   width: 100%;
                   7364:   border: 1px solid black;
                   7365:   background: $pgbg;
1.803     bisitz   7366:   padding: 0;
1.397     albertel 7367:   border-spacing: 1px;
                   7368: }
1.795     www      7369: 
1.397     albertel 7370: table#LC_helpmenu_links tr td {
                   7371:   padding: 1px;
                   7372:   background: $tabbg;
1.399     albertel 7373:   text-align: center;
                   7374:   font-weight: bold;
1.397     albertel 7375: }
1.396     albertel 7376: 
1.795     www      7377: table#LC_helpmenu_links a:link,
                   7378: table#LC_helpmenu_links a:visited,
1.397     albertel 7379: table#LC_helpmenu_links a:active {
                   7380:   text-decoration: none;
                   7381:   color: $font;
                   7382: }
1.795     www      7383: 
1.397     albertel 7384: table#LC_helpmenu_links a:hover {
                   7385:   text-decoration: underline;
                   7386:   color: $vlink;
                   7387: }
1.396     albertel 7388: 
1.417     albertel 7389: .LC_chrt_popup_exists {
                   7390:   border: 1px solid #339933;
                   7391:   margin: -1px;
                   7392: }
1.795     www      7393: 
1.417     albertel 7394: .LC_chrt_popup_up {
                   7395:   border: 1px solid yellow;
                   7396:   margin: -1px;
                   7397: }
1.795     www      7398: 
1.417     albertel 7399: .LC_chrt_popup {
                   7400:   border: 1px solid #8888FF;
                   7401:   background: #CCCCFF;
                   7402: }
1.795     www      7403: 
1.421     albertel 7404: table.LC_pick_box {
                   7405:   border-collapse: separate;
                   7406:   background: white;
                   7407:   border: 1px solid black;
                   7408:   border-spacing: 1px;
                   7409: }
1.795     www      7410: 
1.421     albertel 7411: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   7412:   background: $sidebg;
1.421     albertel 7413:   font-weight: bold;
1.900     bisitz   7414:   text-align: left;
1.740     bisitz   7415:   vertical-align: top;
1.421     albertel 7416:   width: 184px;
                   7417:   padding: 8px;
                   7418: }
1.795     www      7419: 
1.579     raeburn  7420: table.LC_pick_box td.LC_pick_box_value {
                   7421:   text-align: left;
                   7422:   padding: 8px;
                   7423: }
1.795     www      7424: 
1.579     raeburn  7425: table.LC_pick_box td.LC_pick_box_select {
                   7426:   text-align: left;
                   7427:   padding: 8px;
                   7428: }
1.795     www      7429: 
1.424     albertel 7430: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   7431:   padding: 0;
1.421     albertel 7432:   height: 1px;
                   7433:   background: black;
                   7434: }
1.795     www      7435: 
1.421     albertel 7436: table.LC_pick_box td.LC_pick_box_submit {
                   7437:   text-align: right;
                   7438: }
1.795     www      7439: 
1.579     raeburn  7440: table.LC_pick_box td.LC_evenrow_value {
                   7441:   text-align: left;
                   7442:   padding: 8px;
                   7443:   background-color: $data_table_light;
                   7444: }
1.795     www      7445: 
1.579     raeburn  7446: table.LC_pick_box td.LC_oddrow_value {
                   7447:   text-align: left;
                   7448:   padding: 8px;
                   7449:   background-color: $data_table_light;
                   7450: }
1.795     www      7451: 
1.579     raeburn  7452: span.LC_helpform_receipt_cat {
                   7453:   font-weight: bold;
                   7454: }
1.795     www      7455: 
1.424     albertel 7456: table.LC_group_priv_box {
                   7457:   background: white;
                   7458:   border: 1px solid black;
                   7459:   border-spacing: 1px;
                   7460: }
1.795     www      7461: 
1.424     albertel 7462: table.LC_group_priv_box td.LC_pick_box_title {
                   7463:   background: $tabbg;
                   7464:   font-weight: bold;
                   7465:   text-align: right;
                   7466:   width: 184px;
                   7467: }
1.795     www      7468: 
1.424     albertel 7469: table.LC_group_priv_box td.LC_groups_fixed {
                   7470:   background: $data_table_light;
                   7471:   text-align: center;
                   7472: }
1.795     www      7473: 
1.424     albertel 7474: table.LC_group_priv_box td.LC_groups_optional {
                   7475:   background: $data_table_dark;
                   7476:   text-align: center;
                   7477: }
1.795     www      7478: 
1.424     albertel 7479: table.LC_group_priv_box td.LC_groups_functionality {
                   7480:   background: $data_table_darker;
                   7481:   text-align: center;
                   7482:   font-weight: bold;
                   7483: }
1.795     www      7484: 
1.424     albertel 7485: table.LC_group_priv td {
                   7486:   text-align: left;
1.803     bisitz   7487:   padding: 0;
1.424     albertel 7488: }
                   7489: 
                   7490: .LC_navbuttons {
                   7491:   margin: 2ex 0ex 2ex 0ex;
                   7492: }
1.795     www      7493: 
1.423     albertel 7494: .LC_topic_bar {
                   7495:   font-weight: bold;
                   7496:   background: $tabbg;
1.918     wenzelju 7497:   margin: 1em 0em 1em 2em;
1.805     bisitz   7498:   padding: 3px;
1.918     wenzelju 7499:   font-size: 1.2em;
1.423     albertel 7500: }
1.795     www      7501: 
1.423     albertel 7502: .LC_topic_bar span {
1.918     wenzelju 7503:   left: 0.5em;
                   7504:   position: absolute;
1.423     albertel 7505:   vertical-align: middle;
1.918     wenzelju 7506:   font-size: 1.2em;
1.423     albertel 7507: }
1.795     www      7508: 
1.423     albertel 7509: table.LC_course_group_status {
                   7510:   margin: 20px;
                   7511: }
1.795     www      7512: 
1.423     albertel 7513: table.LC_status_selector td {
                   7514:   vertical-align: top;
                   7515:   text-align: center;
1.424     albertel 7516:   padding: 4px;
                   7517: }
1.795     www      7518: 
1.599     albertel 7519: div.LC_feedback_link {
1.616     albertel 7520:   clear: both;
1.829     kalberla 7521:   background: $sidebg;
1.779     bisitz   7522:   width: 100%;
1.829     kalberla 7523:   padding-bottom: 10px;
                   7524:   border: 1px $tabbg solid;
1.833     kalberla 7525:   height: 22px;
                   7526:   line-height: 22px;
                   7527:   padding-top: 5px;
                   7528: }
                   7529: 
                   7530: div.LC_feedback_link img {
                   7531:   height: 22px;
1.867     kalberla 7532:   vertical-align:middle;
1.829     kalberla 7533: }
                   7534: 
1.911     bisitz   7535: div.LC_feedback_link a {
1.829     kalberla 7536:   text-decoration: none;
1.489     raeburn  7537: }
1.795     www      7538: 
1.867     kalberla 7539: div.LC_comblock {
1.911     bisitz   7540:   display:inline;
1.867     kalberla 7541:   color:$font;
                   7542:   font-size:90%;
                   7543: }
                   7544: 
                   7545: div.LC_feedback_link div.LC_comblock {
                   7546:   padding-left:5px;
                   7547: }
                   7548: 
                   7549: div.LC_feedback_link div.LC_comblock a {
                   7550:   color:$font;
                   7551: }
                   7552: 
1.489     raeburn  7553: span.LC_feedback_link {
1.858     bisitz   7554:   /* background: $feedback_link_bg; */
1.599     albertel 7555:   font-size: larger;
                   7556: }
1.795     www      7557: 
1.599     albertel 7558: span.LC_message_link {
1.858     bisitz   7559:   /* background: $feedback_link_bg; */
1.599     albertel 7560:   font-size: larger;
                   7561:   position: absolute;
                   7562:   right: 1em;
1.489     raeburn  7563: }
1.421     albertel 7564: 
1.515     albertel 7565: table.LC_prior_tries {
1.524     albertel 7566:   border: 1px solid #000000;
                   7567:   border-collapse: separate;
                   7568:   border-spacing: 1px;
1.515     albertel 7569: }
1.523     albertel 7570: 
1.515     albertel 7571: table.LC_prior_tries td {
1.524     albertel 7572:   padding: 2px;
1.515     albertel 7573: }
1.523     albertel 7574: 
                   7575: .LC_answer_correct {
1.795     www      7576:   background: lightgreen;
                   7577:   color: darkgreen;
                   7578:   padding: 6px;
1.523     albertel 7579: }
1.795     www      7580: 
1.523     albertel 7581: .LC_answer_charged_try {
1.797     www      7582:   background: #FFAAAA;
1.795     www      7583:   color: darkred;
                   7584:   padding: 6px;
1.523     albertel 7585: }
1.795     www      7586: 
1.779     bisitz   7587: .LC_answer_not_charged_try,
1.523     albertel 7588: .LC_answer_no_grade,
                   7589: .LC_answer_late {
1.795     www      7590:   background: lightyellow;
1.523     albertel 7591:   color: black;
1.795     www      7592:   padding: 6px;
1.523     albertel 7593: }
1.795     www      7594: 
1.523     albertel 7595: .LC_answer_previous {
1.795     www      7596:   background: lightblue;
                   7597:   color: darkblue;
                   7598:   padding: 6px;
1.523     albertel 7599: }
1.795     www      7600: 
1.779     bisitz   7601: .LC_answer_no_message {
1.777     tempelho 7602:   background: #FFFFFF;
                   7603:   color: black;
1.795     www      7604:   padding: 6px;
1.779     bisitz   7605: }
1.795     www      7606: 
1.1075.2.140  raeburn  7607: .LC_answer_unknown,
                   7608: .LC_answer_warning {
1.779     bisitz   7609:   background: orange;
                   7610:   color: black;
1.795     www      7611:   padding: 6px;
1.777     tempelho 7612: }
1.795     www      7613: 
1.529     albertel 7614: span.LC_prior_numerical,
                   7615: span.LC_prior_string,
                   7616: span.LC_prior_custom,
                   7617: span.LC_prior_reaction,
                   7618: span.LC_prior_math {
1.925     bisitz   7619:   font-family: $mono;
1.523     albertel 7620:   white-space: pre;
                   7621: }
                   7622: 
1.525     albertel 7623: span.LC_prior_string {
1.925     bisitz   7624:   font-family: $mono;
1.525     albertel 7625:   white-space: pre;
                   7626: }
                   7627: 
1.523     albertel 7628: table.LC_prior_option {
                   7629:   width: 100%;
                   7630:   border-collapse: collapse;
                   7631: }
1.795     www      7632: 
1.911     bisitz   7633: table.LC_prior_rank,
1.795     www      7634: table.LC_prior_match {
1.528     albertel 7635:   border-collapse: collapse;
                   7636: }
1.795     www      7637: 
1.528     albertel 7638: table.LC_prior_option tr td,
                   7639: table.LC_prior_rank tr td,
                   7640: table.LC_prior_match tr td {
1.524     albertel 7641:   border: 1px solid #000000;
1.515     albertel 7642: }
                   7643: 
1.855     bisitz   7644: .LC_nobreak {
1.544     albertel 7645:   white-space: nowrap;
1.519     raeburn  7646: }
                   7647: 
1.576     raeburn  7648: span.LC_cusr_emph {
                   7649:   font-style: italic;
                   7650: }
                   7651: 
1.633     raeburn  7652: span.LC_cusr_subheading {
                   7653:   font-weight: normal;
                   7654:   font-size: 85%;
                   7655: }
                   7656: 
1.861     bisitz   7657: div.LC_docs_entry_move {
1.859     bisitz   7658:   border: 1px solid #BBBBBB;
1.545     albertel 7659:   background: #DDDDDD;
1.861     bisitz   7660:   width: 22px;
1.859     bisitz   7661:   padding: 1px;
                   7662:   margin: 0;
1.545     albertel 7663: }
                   7664: 
1.861     bisitz   7665: table.LC_data_table tr > td.LC_docs_entry_commands,
                   7666: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 7667:   font-size: x-small;
                   7668: }
1.795     www      7669: 
1.861     bisitz   7670: .LC_docs_entry_parameter {
                   7671:   white-space: nowrap;
                   7672: }
                   7673: 
1.544     albertel 7674: .LC_docs_copy {
1.545     albertel 7675:   color: #000099;
1.544     albertel 7676: }
1.795     www      7677: 
1.544     albertel 7678: .LC_docs_cut {
1.545     albertel 7679:   color: #550044;
1.544     albertel 7680: }
1.795     www      7681: 
1.544     albertel 7682: .LC_docs_rename {
1.545     albertel 7683:   color: #009900;
1.544     albertel 7684: }
1.795     www      7685: 
1.544     albertel 7686: .LC_docs_remove {
1.545     albertel 7687:   color: #990000;
                   7688: }
                   7689: 
1.1075.2.134  raeburn  7690: .LC_domprefs_email,
1.547     albertel 7691: .LC_docs_reinit_warn,
                   7692: .LC_docs_ext_edit {
                   7693:   font-size: x-small;
                   7694: }
                   7695: 
1.545     albertel 7696: table.LC_docs_adddocs td,
                   7697: table.LC_docs_adddocs th {
                   7698:   border: 1px solid #BBBBBB;
                   7699:   padding: 4px;
                   7700:   background: #DDDDDD;
1.543     albertel 7701: }
                   7702: 
1.584     albertel 7703: table.LC_sty_begin {
                   7704:   background: #BBFFBB;
                   7705: }
1.795     www      7706: 
1.584     albertel 7707: table.LC_sty_end {
                   7708:   background: #FFBBBB;
                   7709: }
                   7710: 
1.589     raeburn  7711: table.LC_double_column {
1.803     bisitz   7712:   border-width: 0;
1.589     raeburn  7713:   border-collapse: collapse;
                   7714:   width: 100%;
                   7715:   padding: 2px;
                   7716: }
                   7717: 
                   7718: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  7719:   top: 2px;
1.589     raeburn  7720:   left: 2px;
                   7721:   width: 47%;
                   7722:   vertical-align: top;
                   7723: }
                   7724: 
                   7725: table.LC_double_column tr td.LC_right_col {
                   7726:   top: 2px;
1.779     bisitz   7727:   right: 2px;
1.589     raeburn  7728:   width: 47%;
                   7729:   vertical-align: top;
                   7730: }
                   7731: 
1.591     raeburn  7732: div.LC_left_float {
                   7733:   float: left;
                   7734:   padding-right: 5%;
1.597     albertel 7735:   padding-bottom: 4px;
1.591     raeburn  7736: }
                   7737: 
                   7738: div.LC_clear_float_header {
1.597     albertel 7739:   padding-bottom: 2px;
1.591     raeburn  7740: }
                   7741: 
                   7742: div.LC_clear_float_footer {
1.597     albertel 7743:   padding-top: 10px;
1.591     raeburn  7744:   clear: both;
                   7745: }
                   7746: 
1.597     albertel 7747: div.LC_grade_show_user {
1.941     bisitz   7748: /*  border-left: 5px solid $sidebg; */
                   7749:   border-top: 5px solid #000000;
                   7750:   margin: 50px 0 0 0;
1.936     bisitz   7751:   padding: 15px 0 5px 10px;
1.597     albertel 7752: }
1.795     www      7753: 
1.936     bisitz   7754: div.LC_grade_show_user_odd_row {
1.941     bisitz   7755: /*  border-left: 5px solid #000000; */
                   7756: }
                   7757: 
                   7758: div.LC_grade_show_user div.LC_Box {
                   7759:   margin-right: 50px;
1.597     albertel 7760: }
                   7761: 
                   7762: div.LC_grade_submissions,
                   7763: div.LC_grade_message_center,
1.936     bisitz   7764: div.LC_grade_info_links {
1.597     albertel 7765:   margin: 5px;
                   7766:   width: 99%;
                   7767:   background: #FFFFFF;
                   7768: }
1.795     www      7769: 
1.597     albertel 7770: div.LC_grade_submissions_header,
1.936     bisitz   7771: div.LC_grade_message_center_header {
1.705     tempelho 7772:   font-weight: bold;
                   7773:   font-size: large;
1.597     albertel 7774: }
1.795     www      7775: 
1.597     albertel 7776: div.LC_grade_submissions_body,
1.936     bisitz   7777: div.LC_grade_message_center_body {
1.597     albertel 7778:   border: 1px solid black;
                   7779:   width: 99%;
                   7780:   background: #FFFFFF;
                   7781: }
1.795     www      7782: 
1.613     albertel 7783: table.LC_scantron_action {
                   7784:   width: 100%;
                   7785: }
1.795     www      7786: 
1.613     albertel 7787: table.LC_scantron_action tr th {
1.698     harmsja  7788:   font-weight:bold;
                   7789:   font-style:normal;
1.613     albertel 7790: }
1.795     www      7791: 
1.779     bisitz   7792: .LC_edit_problem_header,
1.614     albertel 7793: div.LC_edit_problem_footer {
1.705     tempelho 7794:   font-weight: normal;
                   7795:   font-size:  medium;
1.602     albertel 7796:   margin: 2px;
1.1060    bisitz   7797:   background-color: $sidebg;
1.600     albertel 7798: }
1.795     www      7799: 
1.600     albertel 7800: div.LC_edit_problem_header,
1.602     albertel 7801: div.LC_edit_problem_header div,
1.614     albertel 7802: div.LC_edit_problem_footer,
                   7803: div.LC_edit_problem_footer div,
1.602     albertel 7804: div.LC_edit_problem_editxml_header,
                   7805: div.LC_edit_problem_editxml_header div {
1.1075.2.112  raeburn  7806:   z-index: 100;
1.600     albertel 7807: }
1.795     www      7808: 
1.600     albertel 7809: div.LC_edit_problem_header_title {
1.705     tempelho 7810:   font-weight: bold;
                   7811:   font-size: larger;
1.602     albertel 7812:   background: $tabbg;
                   7813:   padding: 3px;
1.1060    bisitz   7814:   margin: 0 0 5px 0;
1.602     albertel 7815: }
1.795     www      7816: 
1.602     albertel 7817: table.LC_edit_problem_header_title {
                   7818:   width: 100%;
1.600     albertel 7819:   background: $tabbg;
1.602     albertel 7820: }
                   7821: 
1.1075.2.112  raeburn  7822: div.LC_edit_actionbar {
                   7823:     background-color: $sidebg;
                   7824:     margin: 0;
                   7825:     padding: 0;
                   7826:     line-height: 200%;
1.602     albertel 7827: }
1.795     www      7828: 
1.1075.2.112  raeburn  7829: div.LC_edit_actionbar div{
                   7830:     padding: 0;
                   7831:     margin: 0;
                   7832:     display: inline-block;
1.600     albertel 7833: }
1.795     www      7834: 
1.1075.2.34  raeburn  7835: .LC_edit_opt {
                   7836:   padding-left: 1em;
                   7837:   white-space: nowrap;
                   7838: }
                   7839: 
1.1075.2.57  raeburn  7840: .LC_edit_problem_latexhelper{
                   7841:     text-align: right;
                   7842: }
                   7843: 
                   7844: #LC_edit_problem_colorful div{
                   7845:     margin-left: 40px;
                   7846: }
                   7847: 
1.1075.2.112  raeburn  7848: #LC_edit_problem_codemirror div{
                   7849:     margin-left: 0px;
                   7850: }
                   7851: 
1.911     bisitz   7852: img.stift {
1.803     bisitz   7853:   border-width: 0;
                   7854:   vertical-align: middle;
1.677     riegler  7855: }
1.680     riegler  7856: 
1.923     bisitz   7857: table td.LC_mainmenu_col_fieldset {
1.680     riegler  7858:   vertical-align: top;
1.777     tempelho 7859: }
1.795     www      7860: 
1.716     raeburn  7861: div.LC_createcourse {
1.911     bisitz   7862:   margin: 10px 10px 10px 10px;
1.716     raeburn  7863: }
                   7864: 
1.917     raeburn  7865: .LC_dccid {
1.1075.2.38  raeburn  7866:   float: right;
1.917     raeburn  7867:   margin: 0.2em 0 0 0;
                   7868:   padding: 0;
                   7869:   font-size: 90%;
                   7870:   display:none;
                   7871: }
                   7872: 
1.897     wenzelju 7873: ol.LC_primary_menu a:hover,
1.721     harmsja  7874: ol#LC_MenuBreadcrumbs a:hover,
                   7875: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 7876: ul#LC_secondary_menu a:hover,
1.721     harmsja  7877: .LC_FormSectionClearButton input:hover
1.795     www      7878: ul.LC_TabContent   li:hover a {
1.952     onken    7879:   color:$button_hover;
1.911     bisitz   7880:   text-decoration:none;
1.693     droeschl 7881: }
                   7882: 
1.779     bisitz   7883: h1 {
1.911     bisitz   7884:   padding: 0;
                   7885:   line-height:130%;
1.693     droeschl 7886: }
1.698     harmsja  7887: 
1.911     bisitz   7888: h2,
                   7889: h3,
                   7890: h4,
                   7891: h5,
                   7892: h6 {
                   7893:   margin: 5px 0 5px 0;
                   7894:   padding: 0;
                   7895:   line-height:130%;
1.693     droeschl 7896: }
1.795     www      7897: 
                   7898: .LC_hcell {
1.911     bisitz   7899:   padding:3px 15px 3px 15px;
                   7900:   margin: 0;
                   7901:   background-color:$tabbg;
                   7902:   color:$fontmenu;
                   7903:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 7904: }
1.795     www      7905: 
1.840     bisitz   7906: .LC_Box > .LC_hcell {
1.911     bisitz   7907:   margin: 0 -10px 10px -10px;
1.835     bisitz   7908: }
                   7909: 
1.721     harmsja  7910: .LC_noBorder {
1.911     bisitz   7911:   border: 0;
1.698     harmsja  7912: }
1.693     droeschl 7913: 
1.721     harmsja  7914: .LC_FormSectionClearButton input {
1.911     bisitz   7915:   background-color:transparent;
                   7916:   border: none;
                   7917:   cursor:pointer;
                   7918:   text-decoration:underline;
1.693     droeschl 7919: }
1.763     bisitz   7920: 
                   7921: .LC_help_open_topic {
1.911     bisitz   7922:   color: #FFFFFF;
                   7923:   background-color: #EEEEFF;
                   7924:   margin: 1px;
                   7925:   padding: 4px;
                   7926:   border: 1px solid #000033;
                   7927:   white-space: nowrap;
                   7928:   /* vertical-align: middle; */
1.759     neumanie 7929: }
1.693     droeschl 7930: 
1.911     bisitz   7931: dl,
                   7932: ul,
                   7933: div,
                   7934: fieldset {
                   7935:   margin: 10px 10px 10px 0;
                   7936:   /* overflow: hidden; */
1.693     droeschl 7937: }
1.795     www      7938: 
1.1075.2.161.  .18(raeb 7939:-23): fieldset#LC_selectuser {
                   7940:-23):     margin: 0;
                   7941:-23):     padding: 0;
                   7942:-23): }
                   7943:-23): 
1.1075.2.90  raeburn  7944: article.geogebraweb div {
                   7945:     margin: 0;
                   7946: }
                   7947: 
1.838     bisitz   7948: fieldset > legend {
1.911     bisitz   7949:   font-weight: bold;
                   7950:   padding: 0 5px 0 5px;
1.838     bisitz   7951: }
                   7952: 
1.813     bisitz   7953: #LC_nav_bar {
1.911     bisitz   7954:   float: left;
1.995     raeburn  7955:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   7956:   margin: 0 0 2px 0;
1.807     droeschl 7957: }
                   7958: 
1.916     droeschl 7959: #LC_realm {
                   7960:   margin: 0.2em 0 0 0;
                   7961:   padding: 0;
                   7962:   font-weight: bold;
                   7963:   text-align: center;
1.995     raeburn  7964:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7965: }
                   7966: 
1.911     bisitz   7967: #LC_nav_bar em {
                   7968:   font-weight: bold;
                   7969:   font-style: normal;
1.807     droeschl 7970: }
                   7971: 
1.897     wenzelju 7972: ol.LC_primary_menu {
1.934     droeschl 7973:   margin: 0;
1.1075.2.2  raeburn  7974:   padding: 0;
1.807     droeschl 7975: }
                   7976: 
1.852     droeschl 7977: ol#LC_PathBreadcrumbs {
1.911     bisitz   7978:   margin: 0;
1.693     droeschl 7979: }
                   7980: 
1.897     wenzelju 7981: ol.LC_primary_menu li {
1.1075.2.2  raeburn  7982:   color: RGB(80, 80, 80);
                   7983:   vertical-align: middle;
                   7984:   text-align: left;
                   7985:   list-style: none;
1.1075.2.112  raeburn  7986:   position: relative;
1.1075.2.2  raeburn  7987:   float: left;
1.1075.2.112  raeburn  7988:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7989:   line-height: 1.5em;
1.1075.2.2  raeburn  7990: }
                   7991: 
1.1075.2.113  raeburn  7992: ol.LC_primary_menu li a, 
1.1075.2.112  raeburn  7993: ol.LC_primary_menu li p {
1.1075.2.2  raeburn  7994:   display: block;
                   7995:   margin: 0;
                   7996:   padding: 0 5px 0 10px;
                   7997:   text-decoration: none;
                   7998: }
                   7999: 
1.1075.2.112  raeburn  8000: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   8001:   display: inline-block;
                   8002:   width: 95%;
                   8003:   text-align: left;
                   8004: }
                   8005: 
                   8006: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   8007:   display: inline-block;
                   8008:   width: 5%;
                   8009:   float: right;
                   8010:   text-align: right;
                   8011:   font-size: 70%;
                   8012: }
                   8013: 
                   8014: ol.LC_primary_menu ul {
1.1075.2.2  raeburn  8015:   display: none;
1.1075.2.112  raeburn  8016:   width: 15em;
1.1075.2.2  raeburn  8017:   background-color: $data_table_light;
1.1075.2.112  raeburn  8018:   position: absolute;
                   8019:   top: 100%;
                   8020: }
                   8021: 
                   8022: ol.LC_primary_menu ul ul {
                   8023:   left: 100%;
                   8024:   top: 0;
1.1075.2.2  raeburn  8025: }
                   8026: 
1.1075.2.112  raeburn  8027: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1075.2.2  raeburn  8028:   display: block;
                   8029:   position: absolute;
                   8030:   margin: 0;
                   8031:   padding: 0;
1.1075.2.5  raeburn  8032:   z-index: 2;
1.1075.2.2  raeburn  8033: }
                   8034: 
                   8035: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1075.2.112  raeburn  8036: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1075.2.2  raeburn  8037:   font-size: 90%;
1.911     bisitz   8038:   vertical-align: top;
1.1075.2.2  raeburn  8039:   float: none;
1.1075.2.5  raeburn  8040:   border-left: 1px solid black;
                   8041:   border-right: 1px solid black;
1.1075.2.112  raeburn  8042: /* A dark bottom border to visualize different menu options;
                   8043: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   8044:   border-bottom: 1px solid $data_table_dark;
1.1075.2.2  raeburn  8045: }
                   8046: 
1.1075.2.112  raeburn  8047: ol.LC_primary_menu li li p:hover {
                   8048:   color:$button_hover;
                   8049:   text-decoration:none;
                   8050:   background-color:$data_table_dark;
1.1075.2.2  raeburn  8051: }
                   8052: 
                   8053: ol.LC_primary_menu li li a:hover {
                   8054:    color:$button_hover;
                   8055:    background-color:$data_table_dark;
1.693     droeschl 8056: }
                   8057: 
1.1075.2.112  raeburn  8058: /* Font-size equal to the size of the predecessors*/
                   8059: ol.LC_primary_menu li:hover li li {
                   8060:   font-size: 100%;
                   8061: }
                   8062: 
1.897     wenzelju 8063: ol.LC_primary_menu li img {
1.911     bisitz   8064:   vertical-align: bottom;
1.934     droeschl 8065:   height: 1.1em;
1.1075.2.3  raeburn  8066:   margin: 0.2em 0 0 0;
1.693     droeschl 8067: }
                   8068: 
1.897     wenzelju 8069: ol.LC_primary_menu a {
1.911     bisitz   8070:   color: RGB(80, 80, 80);
                   8071:   text-decoration: none;
1.693     droeschl 8072: }
1.795     www      8073: 
1.949     droeschl 8074: ol.LC_primary_menu a.LC_new_message {
                   8075:   font-weight:bold;
                   8076:   color: darkred;
                   8077: }
                   8078: 
1.975     raeburn  8079: ol.LC_docs_parameters {
                   8080:   margin-left: 0;
                   8081:   padding: 0;
                   8082:   list-style: none;
                   8083: }
                   8084: 
                   8085: ol.LC_docs_parameters li {
                   8086:   margin: 0;
                   8087:   padding-right: 20px;
                   8088:   display: inline;
                   8089: }
                   8090: 
1.976     raeburn  8091: ol.LC_docs_parameters li:before {
                   8092:   content: "\\002022 \\0020";
                   8093: }
                   8094: 
                   8095: li.LC_docs_parameters_title {
                   8096:   font-weight: bold;
                   8097: }
                   8098: 
                   8099: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   8100:   content: "";
                   8101: }
                   8102: 
1.897     wenzelju 8103: ul#LC_secondary_menu {
1.1075.2.23  raeburn  8104:   clear: right;
1.911     bisitz   8105:   color: $fontmenu;
                   8106:   background: $tabbg;
                   8107:   list-style: none;
                   8108:   padding: 0;
                   8109:   margin: 0;
                   8110:   width: 100%;
1.995     raeburn  8111:   text-align: left;
1.1075.2.4  raeburn  8112:   float: left;
1.808     droeschl 8113: }
                   8114: 
1.897     wenzelju 8115: ul#LC_secondary_menu li {
1.911     bisitz   8116:   font-weight: bold;
                   8117:   line-height: 1.8em;
                   8118:   border-right: 1px solid black;
1.1075.2.4  raeburn  8119:   float: left;
                   8120: }
                   8121: 
                   8122: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   8123:   background-color: $data_table_light;
                   8124: }
                   8125: 
                   8126: ul#LC_secondary_menu li a {
                   8127:   padding: 0 0.8em;
                   8128: }
                   8129: 
                   8130: ul#LC_secondary_menu li ul {
                   8131:   display: none;
                   8132: }
                   8133: 
                   8134: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   8135:   display: block;
                   8136:   position: absolute;
                   8137:   margin: 0;
                   8138:   padding: 0;
                   8139:   list-style:none;
                   8140:   float: none;
                   8141:   background-color: $data_table_light;
1.1075.2.5  raeburn  8142:   z-index: 2;
1.1075.2.10  raeburn  8143:   margin-left: -1px;
1.1075.2.4  raeburn  8144: }
                   8145: 
                   8146: ul#LC_secondary_menu li ul li {
                   8147:   font-size: 90%;
                   8148:   vertical-align: top;
                   8149:   border-left: 1px solid black;
                   8150:   border-right: 1px solid black;
1.1075.2.33  raeburn  8151:   background-color: $data_table_light;
1.1075.2.4  raeburn  8152:   list-style:none;
                   8153:   float: none;
                   8154: }
                   8155: 
                   8156: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   8157:   background-color: $data_table_dark;
1.807     droeschl 8158: }
                   8159: 
1.847     tempelho 8160: ul.LC_TabContent {
1.911     bisitz   8161:   display:block;
                   8162:   background: $sidebg;
                   8163:   border-bottom: solid 1px $lg_border_color;
                   8164:   list-style:none;
1.1020    raeburn  8165:   margin: -1px -10px 0 -10px;
1.911     bisitz   8166:   padding: 0;
1.693     droeschl 8167: }
                   8168: 
1.795     www      8169: ul.LC_TabContent li,
                   8170: ul.LC_TabContentBigger li {
1.911     bisitz   8171:   float:left;
1.741     harmsja  8172: }
1.795     www      8173: 
1.897     wenzelju 8174: ul#LC_secondary_menu li a {
1.911     bisitz   8175:   color: $fontmenu;
                   8176:   text-decoration: none;
1.693     droeschl 8177: }
1.795     www      8178: 
1.721     harmsja  8179: ul.LC_TabContent {
1.952     onken    8180:   min-height:20px;
1.721     harmsja  8181: }
1.795     www      8182: 
                   8183: ul.LC_TabContent li {
1.911     bisitz   8184:   vertical-align:middle;
1.959     onken    8185:   padding: 0 16px 0 10px;
1.911     bisitz   8186:   background-color:$tabbg;
                   8187:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  8188:   border-left: solid 1px $font;
1.721     harmsja  8189: }
1.795     www      8190: 
1.847     tempelho 8191: ul.LC_TabContent .right {
1.911     bisitz   8192:   float:right;
1.847     tempelho 8193: }
                   8194: 
1.911     bisitz   8195: ul.LC_TabContent li a,
                   8196: ul.LC_TabContent li {
                   8197:   color:rgb(47,47,47);
                   8198:   text-decoration:none;
                   8199:   font-size:95%;
                   8200:   font-weight:bold;
1.952     onken    8201:   min-height:20px;
                   8202: }
                   8203: 
1.959     onken    8204: ul.LC_TabContent li a:hover,
                   8205: ul.LC_TabContent li a:focus {
1.952     onken    8206:   color: $button_hover;
1.959     onken    8207:   background:none;
                   8208:   outline:none;
1.952     onken    8209: }
                   8210: 
                   8211: ul.LC_TabContent li:hover {
                   8212:   color: $button_hover;
                   8213:   cursor:pointer;
1.721     harmsja  8214: }
1.795     www      8215: 
1.911     bisitz   8216: ul.LC_TabContent li.active {
1.952     onken    8217:   color: $font;
1.911     bisitz   8218:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    8219:   border-bottom:solid 1px #FFFFFF;
                   8220:   cursor: default;
1.744     ehlerst  8221: }
1.795     www      8222: 
1.959     onken    8223: ul.LC_TabContent li.active a {
                   8224:   color:$font;
                   8225:   background:#FFFFFF;
                   8226:   outline: none;
                   8227: }
1.1047    raeburn  8228: 
                   8229: ul.LC_TabContent li.goback {
                   8230:   float: left;
                   8231:   border-left: none;
                   8232: }
                   8233: 
1.870     tempelho 8234: #maincoursedoc {
1.911     bisitz   8235:   clear:both;
1.870     tempelho 8236: }
                   8237: 
                   8238: ul.LC_TabContentBigger {
1.911     bisitz   8239:   display:block;
                   8240:   list-style:none;
                   8241:   padding: 0;
1.870     tempelho 8242: }
                   8243: 
1.795     www      8244: ul.LC_TabContentBigger li {
1.911     bisitz   8245:   vertical-align:bottom;
                   8246:   height: 30px;
                   8247:   font-size:110%;
                   8248:   font-weight:bold;
                   8249:   color: #737373;
1.841     tempelho 8250: }
                   8251: 
1.957     onken    8252: ul.LC_TabContentBigger li.active {
                   8253:   position: relative;
                   8254:   top: 1px;
                   8255: }
                   8256: 
1.870     tempelho 8257: ul.LC_TabContentBigger li a {
1.911     bisitz   8258:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   8259:   height: 30px;
                   8260:   line-height: 30px;
                   8261:   text-align: center;
                   8262:   display: block;
                   8263:   text-decoration: none;
1.958     onken    8264:   outline: none;  
1.741     harmsja  8265: }
1.795     www      8266: 
1.870     tempelho 8267: ul.LC_TabContentBigger li.active a {
1.911     bisitz   8268:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   8269:   color:$font;
1.744     ehlerst  8270: }
1.795     www      8271: 
1.870     tempelho 8272: ul.LC_TabContentBigger li b {
1.911     bisitz   8273:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   8274:   display: block;
                   8275:   float: left;
                   8276:   padding: 0 30px;
1.957     onken    8277:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 8278: }
                   8279: 
1.956     onken    8280: ul.LC_TabContentBigger li:hover b {
                   8281:   color:$button_hover;
                   8282: }
                   8283: 
1.870     tempelho 8284: ul.LC_TabContentBigger li.active b {
1.911     bisitz   8285:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   8286:   color:$font;
1.957     onken    8287:   border: 0;
1.741     harmsja  8288: }
1.693     droeschl 8289: 
1.870     tempelho 8290: 
1.862     bisitz   8291: ul.LC_CourseBreadcrumbs {
                   8292:   background: $sidebg;
1.1020    raeburn  8293:   height: 2em;
1.862     bisitz   8294:   padding-left: 10px;
1.1020    raeburn  8295:   margin: 0;
1.862     bisitz   8296:   list-style-position: inside;
                   8297: }
                   8298: 
1.911     bisitz   8299: ol#LC_MenuBreadcrumbs,
1.862     bisitz   8300: ol#LC_PathBreadcrumbs {
1.911     bisitz   8301:   padding-left: 10px;
                   8302:   margin: 0;
1.933     droeschl 8303:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 8304: }
                   8305: 
1.911     bisitz   8306: ol#LC_MenuBreadcrumbs li,
                   8307: ol#LC_PathBreadcrumbs li,
1.862     bisitz   8308: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   8309:   display: inline;
1.933     droeschl 8310:   white-space: normal;  
1.693     droeschl 8311: }
                   8312: 
1.823     bisitz   8313: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   8314: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   8315:   text-decoration: none;
                   8316:   font-size:90%;
1.693     droeschl 8317: }
1.795     www      8318: 
1.969     droeschl 8319: ol#LC_MenuBreadcrumbs h1 {
                   8320:   display: inline;
                   8321:   font-size: 90%;
                   8322:   line-height: 2.5em;
                   8323:   margin: 0;
                   8324:   padding: 0;
                   8325: }
                   8326: 
1.795     www      8327: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   8328:   text-decoration:none;
                   8329:   font-size:100%;
                   8330:   font-weight:bold;
1.693     droeschl 8331: }
1.795     www      8332: 
1.840     bisitz   8333: .LC_Box {
1.911     bisitz   8334:   border: solid 1px $lg_border_color;
                   8335:   padding: 0 10px 10px 10px;
1.746     neumanie 8336: }
1.795     www      8337: 
1.1020    raeburn  8338: .LC_DocsBox {
                   8339:   border: solid 1px $lg_border_color;
                   8340:   padding: 0 0 10px 10px;
                   8341: }
                   8342: 
1.795     www      8343: .LC_AboutMe_Image {
1.911     bisitz   8344:   float:left;
                   8345:   margin-right:10px;
1.747     neumanie 8346: }
1.795     www      8347: 
                   8348: .LC_Clear_AboutMe_Image {
1.911     bisitz   8349:   clear:left;
1.747     neumanie 8350: }
1.795     www      8351: 
1.721     harmsja  8352: dl.LC_ListStyleClean dt {
1.911     bisitz   8353:   padding-right: 5px;
                   8354:   display: table-header-group;
1.693     droeschl 8355: }
                   8356: 
1.721     harmsja  8357: dl.LC_ListStyleClean dd {
1.911     bisitz   8358:   display: table-row;
1.693     droeschl 8359: }
                   8360: 
1.721     harmsja  8361: .LC_ListStyleClean,
                   8362: .LC_ListStyleSimple,
                   8363: .LC_ListStyleNormal,
1.795     www      8364: .LC_ListStyleSpecial {
1.911     bisitz   8365:   /* display:block; */
                   8366:   list-style-position: inside;
                   8367:   list-style-type: none;
                   8368:   overflow: hidden;
                   8369:   padding: 0;
1.693     droeschl 8370: }
                   8371: 
1.721     harmsja  8372: .LC_ListStyleSimple li,
                   8373: .LC_ListStyleSimple dd,
                   8374: .LC_ListStyleNormal li,
                   8375: .LC_ListStyleNormal dd,
                   8376: .LC_ListStyleSpecial li,
1.795     www      8377: .LC_ListStyleSpecial dd {
1.911     bisitz   8378:   margin: 0;
                   8379:   padding: 5px 5px 5px 10px;
                   8380:   clear: both;
1.693     droeschl 8381: }
                   8382: 
1.721     harmsja  8383: .LC_ListStyleClean li,
                   8384: .LC_ListStyleClean dd {
1.911     bisitz   8385:   padding-top: 0;
                   8386:   padding-bottom: 0;
1.693     droeschl 8387: }
                   8388: 
1.721     harmsja  8389: .LC_ListStyleSimple dd,
1.795     www      8390: .LC_ListStyleSimple li {
1.911     bisitz   8391:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 8392: }
                   8393: 
1.721     harmsja  8394: .LC_ListStyleSpecial li,
                   8395: .LC_ListStyleSpecial dd {
1.911     bisitz   8396:   list-style-type: none;
                   8397:   background-color: RGB(220, 220, 220);
                   8398:   margin-bottom: 4px;
1.693     droeschl 8399: }
                   8400: 
1.721     harmsja  8401: table.LC_SimpleTable {
1.911     bisitz   8402:   margin:5px;
                   8403:   border:solid 1px $lg_border_color;
1.795     www      8404: }
1.693     droeschl 8405: 
1.721     harmsja  8406: table.LC_SimpleTable tr {
1.911     bisitz   8407:   padding: 0;
                   8408:   border:solid 1px $lg_border_color;
1.693     droeschl 8409: }
1.795     www      8410: 
                   8411: table.LC_SimpleTable thead {
1.911     bisitz   8412:   background:rgb(220,220,220);
1.693     droeschl 8413: }
                   8414: 
1.721     harmsja  8415: div.LC_columnSection {
1.911     bisitz   8416:   display: block;
                   8417:   clear: both;
                   8418:   overflow: hidden;
                   8419:   margin: 0;
1.693     droeschl 8420: }
                   8421: 
1.721     harmsja  8422: div.LC_columnSection>* {
1.911     bisitz   8423:   float: left;
                   8424:   margin: 10px 20px 10px 0;
                   8425:   overflow:hidden;
1.693     droeschl 8426: }
1.721     harmsja  8427: 
1.795     www      8428: table em {
1.911     bisitz   8429:   font-weight: bold;
                   8430:   font-style: normal;
1.748     schulted 8431: }
1.795     www      8432: 
1.779     bisitz   8433: table.LC_tableBrowseRes,
1.795     www      8434: table.LC_tableOfContent {
1.911     bisitz   8435:   border:none;
                   8436:   border-spacing: 1px;
                   8437:   padding: 3px;
                   8438:   background-color: #FFFFFF;
                   8439:   font-size: 90%;
1.753     droeschl 8440: }
1.789     droeschl 8441: 
1.911     bisitz   8442: table.LC_tableOfContent {
                   8443:   border-collapse: collapse;
1.789     droeschl 8444: }
                   8445: 
1.771     droeschl 8446: table.LC_tableBrowseRes a,
1.768     schulted 8447: table.LC_tableOfContent a {
1.911     bisitz   8448:   background-color: transparent;
                   8449:   text-decoration: none;
1.753     droeschl 8450: }
                   8451: 
1.795     www      8452: table.LC_tableOfContent img {
1.911     bisitz   8453:   border: none;
                   8454:   height: 1.3em;
                   8455:   vertical-align: text-bottom;
                   8456:   margin-right: 0.3em;
1.753     droeschl 8457: }
1.757     schulted 8458: 
1.795     www      8459: a#LC_content_toolbar_firsthomework {
1.911     bisitz   8460:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  8461: }
                   8462: 
1.795     www      8463: a#LC_content_toolbar_everything {
1.911     bisitz   8464:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  8465: }
                   8466: 
1.795     www      8467: a#LC_content_toolbar_uncompleted {
1.911     bisitz   8468:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  8469: }
                   8470: 
1.795     www      8471: #LC_content_toolbar_clearbubbles {
1.911     bisitz   8472:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  8473: }
                   8474: 
1.795     www      8475: a#LC_content_toolbar_changefolder {
1.911     bisitz   8476:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 8477: }
                   8478: 
1.795     www      8479: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   8480:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 8481: }
                   8482: 
1.1043    raeburn  8483: a#LC_content_toolbar_edittoplevel {
                   8484:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   8485: }
                   8486: 
1.1075.2.161.  .12(raeb 8487:-23): a#LC_content_toolbar_printout {
                   8488:-23):   background-image:url(/res/adm/pages/printout.gif);
                   8489:-23): }
                   8490:-23): 
1.795     www      8491: ul#LC_toolbar li a:hover {
1.911     bisitz   8492:   background-position: bottom center;
1.757     schulted 8493: }
                   8494: 
1.795     www      8495: ul#LC_toolbar {
1.911     bisitz   8496:   padding: 0;
                   8497:   margin: 2px;
                   8498:   list-style:none;
                   8499:   position:relative;
                   8500:   background-color:white;
1.1075.2.9  raeburn  8501:   overflow: auto;
1.757     schulted 8502: }
                   8503: 
1.795     www      8504: ul#LC_toolbar li {
1.911     bisitz   8505:   border:1px solid white;
                   8506:   padding: 0;
                   8507:   margin: 0;
                   8508:   float: left;
                   8509:   display:inline;
                   8510:   vertical-align:middle;
1.1075.2.9  raeburn  8511:   white-space: nowrap;
1.911     bisitz   8512: }
1.757     schulted 8513: 
1.783     amueller 8514: 
1.795     www      8515: a.LC_toolbarItem {
1.911     bisitz   8516:   display:block;
                   8517:   padding: 0;
                   8518:   margin: 0;
                   8519:   height: 32px;
                   8520:   width: 32px;
                   8521:   color:white;
                   8522:   border: none;
                   8523:   background-repeat:no-repeat;
                   8524:   background-color:transparent;
1.757     schulted 8525: }
                   8526: 
1.915     droeschl 8527: ul.LC_funclist {
                   8528:     margin: 0;
                   8529:     padding: 0.5em 1em 0.5em 0;
                   8530: }
                   8531: 
1.933     droeschl 8532: ul.LC_funclist > li:first-child {
                   8533:     font-weight:bold; 
                   8534:     margin-left:0.8em;
                   8535: }
                   8536: 
1.915     droeschl 8537: ul.LC_funclist + ul.LC_funclist {
                   8538:     /* 
                   8539:        left border as a seperator if we have more than
                   8540:        one list 
                   8541:     */
                   8542:     border-left: 1px solid $sidebg;
                   8543:     /* 
                   8544:        this hides the left border behind the border of the 
                   8545:        outer box if element is wrapped to the next 'line' 
                   8546:     */
                   8547:     margin-left: -1px;
                   8548: }
                   8549: 
1.843     bisitz   8550: ul.LC_funclist li {
1.915     droeschl 8551:   display: inline;
1.782     bisitz   8552:   white-space: nowrap;
1.915     droeschl 8553:   margin: 0 0 0 25px;
                   8554:   line-height: 150%;
1.782     bisitz   8555: }
                   8556: 
1.974     wenzelju 8557: .LC_hidden {
                   8558:   display: none;
                   8559: }
                   8560: 
1.1030    www      8561: .LCmodal-overlay {
                   8562: 		position:fixed;
                   8563: 		top:0;
                   8564: 		right:0;
                   8565: 		bottom:0;
                   8566: 		left:0;
                   8567: 		height:100%;
                   8568: 		width:100%;
                   8569: 		margin:0;
                   8570: 		padding:0;
                   8571: 		background:#999;
                   8572: 		opacity:.75;
                   8573: 		filter: alpha(opacity=75);
                   8574: 		-moz-opacity: 0.75;
                   8575: 		z-index:101;
                   8576: }
                   8577: 
                   8578: * html .LCmodal-overlay {   
                   8579: 		position: absolute;
                   8580: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   8581: }
                   8582: 
                   8583: .LCmodal-window {
                   8584: 		position:fixed;
                   8585: 		top:50%;
                   8586: 		left:50%;
                   8587: 		margin:0;
                   8588: 		padding:0;
                   8589: 		z-index:102;
                   8590: 	}
                   8591: 
                   8592: * html .LCmodal-window {
                   8593: 		position:absolute;
                   8594: }
                   8595: 
                   8596: .LCclose-window {
                   8597: 		position:absolute;
                   8598: 		width:32px;
                   8599: 		height:32px;
                   8600: 		right:8px;
                   8601: 		top:8px;
                   8602: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   8603: 		text-indent:-99999px;
                   8604: 		overflow:hidden;
                   8605: 		cursor:pointer;
                   8606: }
                   8607: 
1.1075.2.158  raeburn  8608: .LCisDisabled {
                   8609:   cursor: not-allowed;
                   8610:   opacity: 0.5;
                   8611: }
                   8612: 
                   8613: a[aria-disabled="true"] {
                   8614:   color: currentColor;
                   8615:   display: inline-block;  /* For IE11/ MS Edge bug */
                   8616:   pointer-events: none;
                   8617:   text-decoration: none;
                   8618: }
                   8619: 
1.1075.2.141  raeburn  8620: pre.LC_wordwrap {
                   8621:   white-space: pre-wrap;
                   8622:   white-space: -moz-pre-wrap;
                   8623:   white-space: -pre-wrap;
                   8624:   white-space: -o-pre-wrap;
                   8625:   word-wrap: break-word;
                   8626: }
                   8627: 
1.1075.2.17  raeburn  8628: /*
1.1075.2.161.  .21(raeb 8629:-24):   styles used for response display
                   8630:-24): */
                   8631:-24): div.LC_radiofoil, div.LC_rankfoil {
                   8632:-24):   margin: .5em 0em .5em 0em;
                   8633:-24): }
                   8634:-24): table.LC_itemgroup {
                   8635:-24):   margin-top: 1em;
                   8636:-24): }
                   8637:-24): 
                   8638:-24): /*
1.1075.2.17  raeburn  8639:   styles used by TTH when "Default set of options to pass to tth/m
                   8640:   when converting TeX" in course settings has been set
                   8641: 
                   8642:   option passed: -t
                   8643: 
                   8644: */
                   8645: 
                   8646: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   8647: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   8648: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   8649: td div.norm {line-height:normal;}
                   8650: 
                   8651: /*
                   8652:   option passed -y3
                   8653: */
                   8654: 
                   8655: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   8656: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   8657: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   8658: 
1.1075.2.161.  .21(raeb 8659:-24): /*
                   8660:-24):   sections with roles, for content only
                   8661:-24): */
                   8662:-24): section[class^="role-"] {
                   8663:-24):   padding-left: 10px;
                   8664:-24):   padding-right: 5px;
                   8665:-24):   margin-top: 8px;
                   8666:-24):   margin-bottom: 8px;
                   8667:-24):   border: 1px solid #2A4;
                   8668:-24):   border-radius: 5px;
                   8669:-24):   box-shadow: 0px 1px 1px #BBB;
                   8670:-24): }
                   8671:-24): section[class^="role-"]>h1 {
                   8672:-24):   position: relative;
                   8673:-24):   margin: 0px;
                   8674:-24):   padding-top: 10px;
                   8675:-24):   padding-left: 40px;
                   8676:-24): }
                   8677:-24): section[class^="role-"]>h1:before {
                   8678:-24):   position: absolute;
                   8679:-24):   left: -5px;
                   8680:-24):   top: 5px;
                   8681:-24): }
                   8682:-24): section.role-activity>h1:before {
                   8683:-24):   content:url('/adm/daxe/images/section_icons/activity.png');
                   8684:-24): }
                   8685:-24): section.role-advice>h1:before {
                   8686:-24):   content:url('/adm/daxe/images/section_icons/advice.png');
                   8687:-24): }
                   8688:-24): section.role-bibliography>h1:before {
                   8689:-24):   content:url('/adm/daxe/images/section_icons/bibliography.png');
                   8690:-24): }
                   8691:-24): section.role-citation>h1:before {
                   8692:-24):   content:url('/adm/daxe/images/section_icons/citation.png');
                   8693:-24): }
                   8694:-24): section.role-conclusion>h1:before {
                   8695:-24):   content:url('/adm/daxe/images/section_icons/conclusion.png');
                   8696:-24): }
                   8697:-24): section.role-definition>h1:before {
                   8698:-24):   content:url('/adm/daxe/images/section_icons/definition.png');
                   8699:-24): }
                   8700:-24): section.role-demonstration>h1:before {
                   8701:-24):   content:url('/adm/daxe/images/section_icons/demonstration.png');
                   8702:-24): }
                   8703:-24): section.role-example>h1:before {
                   8704:-24):   content:url('/adm/daxe/images/section_icons/example.png');
                   8705:-24): }
                   8706:-24): section.role-explanation>h1:before {
                   8707:-24):   content:url('/adm/daxe/images/section_icons/explanation.png');
                   8708:-24): }
                   8709:-24): section.role-introduction>h1:before {
                   8710:-24):   content:url('/adm/daxe/images/section_icons/introduction.png');
                   8711:-24): }
                   8712:-24): section.role-method>h1:before {
                   8713:-24):   content:url('/adm/daxe/images/section_icons/method.png');
                   8714:-24): }
                   8715:-24): section.role-more_information>h1:before {
                   8716:-24):   content:url('/adm/daxe/images/section_icons/more_information.png');
                   8717:-24): }
                   8718:-24): section.role-objectives>h1:before {
                   8719:-24):   content:url('/adm/daxe/images/section_icons/objectives.png');
                   8720:-24): }
                   8721:-24): section.role-prerequisites>h1:before {
                   8722:-24):   content:url('/adm/daxe/images/section_icons/prerequisites.png');
                   8723:-24): }
                   8724:-24): section.role-remark>h1:before {
                   8725:-24):   content:url('/adm/daxe/images/section_icons/remark.png');
                   8726:-24): }
                   8727:-24): section.role-reminder>h1:before {
                   8728:-24):   content:url('/adm/daxe/images/section_icons/reminder.png');
                   8729:-24): }
                   8730:-24): section.role-summary>h1:before {
                   8731:-24):   content:url('/adm/daxe/images/section_icons/summary.png');
                   8732:-24): }
                   8733:-24): section.role-syntax>h1:before {
                   8734:-24):   content:url('/adm/daxe/images/section_icons/syntax.png');
                   8735:-24): }
                   8736:-24): section.role-warning>h1:before {
                   8737:-24):   content:url('/adm/daxe/images/section_icons/warning.png');
                   8738:-24): }
                   8739:-24): 
1.1075.2.121  raeburn  8740: #LC_minitab_header {
                   8741:   float:left;
                   8742:   width:100%;
                   8743:   background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
                   8744:   font-size:93%;
                   8745:   line-height:normal;
                   8746:   margin: 0.5em 0 0.5em 0;
                   8747: }
                   8748: #LC_minitab_header ul {
                   8749:   margin:0;
                   8750:   padding:10px 10px 0;
                   8751:   list-style:none;
                   8752: }
                   8753: #LC_minitab_header li {
                   8754:   float:left;
                   8755:   background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
                   8756:   margin:0;
                   8757:   padding:0 0 0 9px;
                   8758: }
                   8759: #LC_minitab_header a {
                   8760:   display:block;
                   8761:   background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
                   8762:   padding:5px 15px 4px 6px;
                   8763: }
                   8764: #LC_minitab_header #LC_current_minitab {
                   8765:   background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
                   8766: }
                   8767: #LC_minitab_header #LC_current_minitab a {
                   8768:   background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
                   8769:   padding-bottom:5px;
                   8770: }
                   8771: 
                   8772: 
1.343     albertel 8773: END
                   8774: }
                   8775: 
1.306     albertel 8776: =pod
                   8777: 
                   8778: =item * &headtag()
                   8779: 
                   8780: Returns a uniform footer for LON-CAPA web pages.
                   8781: 
1.307     albertel 8782: Inputs: $title - optional title for the head
                   8783:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 8784:         $args - optional arguments
1.319     albertel 8785:             force_register - if is true call registerurl so the remote is 
                   8786:                              informed
1.415     albertel 8787:             redirect       -> array ref of
                   8788:                                    1- seconds before redirect occurs
                   8789:                                    2- url to redirect to
                   8790:                                    3- whether the side effect should occur
1.315     albertel 8791:                            (side effect of setting 
                   8792:                                $env{'internal.head.redirect'} to the url 
1.1075.2.161.  .9(raebu 8793:22):                                redirected to)
                   8794:22):                                    4- whether the redirect target should be
                   8795:22):                                       the opener of the current (pop-up)
                   8796:22):                                       window (side effect of setting
                   8797:22):                                       $env{'internal.head.to_opener'} to
                   8798:22):                                       1, if true.
          .10(raeb 8799:-22):                                    5- whether encrypt check should be skipped
1.352     albertel 8800:             domain         -> force to color decorate a page for a specific
                   8801:                                domain
                   8802:             function       -> force usage of a specific rolish color scheme
                   8803:             bgcolor        -> override the default page bgcolor
1.460     albertel 8804:             no_auto_mt_title
                   8805:                            -> prevent &mt()ing the title arg
1.464     albertel 8806: 
1.306     albertel 8807: =cut
                   8808: 
                   8809: sub headtag {
1.313     albertel 8810:     my ($title,$head_extra,$args) = @_;
1.306     albertel 8811:     
1.363     albertel 8812:     my $function = $args->{'function'} || &get_users_function();
                   8813:     my $domain   = $args->{'domain'}   || &determinedomain();
                   8814:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  8815:     my $httphost = $args->{'use_absolute'};
1.418     albertel 8816:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 8817: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 8818: 		   #time(),
1.418     albertel 8819: 		   $env{'environment.color.timestamp'},
1.363     albertel 8820: 		   $function,$domain,$bgcolor);
                   8821: 
1.369     www      8822:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 8823: 
1.308     albertel 8824:     my $result =
                   8825: 	'<head>'.
1.1075.2.56  raeburn  8826: 	&font_settings($args);
1.319     albertel 8827: 
1.1075.2.72  raeburn  8828:     my $inhibitprint;
                   8829:     if ($args->{'print_suppress'}) {
                   8830:         $inhibitprint = &print_suppression();
                   8831:     }
1.1064    raeburn  8832: 
1.461     albertel 8833:     if (!$args->{'frameset'}) {
                   8834: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   8835:     }
1.1075.2.12  raeburn  8836:     if ($args->{'force_register'}) {
                   8837:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 8838:     }
1.436     albertel 8839:     if (!$args->{'no_nav_bar'} 
                   8840: 	&& !$args->{'only_body'}
                   8841: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  8842: 	$result .= &help_menu_js($httphost);
1.1032    www      8843:         $result.=&modal_window();
1.1038    www      8844:         $result.=&togglebox_script();
1.1034    www      8845:         $result.=&wishlist_window();
1.1041    www      8846:         $result.=&LCprogressbarUpdate_script();
1.1034    www      8847:     } else {
                   8848:         if ($args->{'add_modal'}) {
                   8849:            $result.=&modal_window();
                   8850:         }
                   8851:         if ($args->{'add_wishlist'}) {
                   8852:            $result.=&wishlist_window();
                   8853:         }
1.1038    www      8854:         if ($args->{'add_togglebox'}) {
                   8855:            $result.=&togglebox_script();
                   8856:         }
1.1041    www      8857:         if ($args->{'add_progressbar'}) {
                   8858:            $result.=&LCprogressbarUpdate_script();
                   8859:         }
1.436     albertel 8860:     }
1.314     albertel 8861:     if (ref($args->{'redirect'})) {
1.1075.2.161.  .10(raeb 8862:-22): 	my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
                   8863:-22):         if (!$skip_enc_check) {
                   8864:-22): 	    $url = &Apache::lonenc::check_encrypt($url);
                   8865:-22):         }
1.414     albertel 8866: 	if (!$inhibit_continue) {
                   8867: 	    $env{'internal.head.redirect'} = $url;
                   8868: 	}
1.1075.2.161.  .9(raebu 8869:22):         $result.=<<"ADDMETA";
1.313     albertel 8870: <meta http-equiv="pragma" content="no-cache" />
1.1075.2.161.  .9(raebu 8871:22): ADDMETA
                   8872:22):         if ($to_opener) {
                   8873:22):             $env{'internal.head.to_opener'} = 1;
                   8874:22):             my $dest = &js_escape($url);
                   8875:22):             my $timeout = int($time * 1000);
                   8876:22):             $result .=<<"ENDJS";
                   8877:22): <script type="text/javascript">
                   8878:22): // <![CDATA[
                   8879:22): function LC_To_Opener() {
                   8880:22):     var dest = '$dest';
                   8881:22):     if (dest != '') {
                   8882:22):         if (window.opener != null && !window.opener.closed) {
                   8883:22):             window.opener.location.href=dest;
                   8884:22):             window.close();
                   8885:22):         } else {
                   8886:22):             window.location.href=dest;
                   8887:22):         }
                   8888:22):     }
                   8889:22): }
                   8890:22): \$(document).ready(function () {
                   8891:22):     setTimeout('LC_To_Opener()',$timeout);
                   8892:22): });
                   8893:22): // ]]>
                   8894:22): </script>
                   8895:22): ENDJS
                   8896:22):         } else {
                   8897:22):             $result.=<<"ADDMETA";
1.344     albertel 8898: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 8899: ADDMETA
1.1075.2.161.  .9(raebu 8900:22):         }
1.1075.2.89  raeburn  8901:     } else {
                   8902:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   8903:             my $requrl = $env{'request.uri'};
                   8904:             if ($requrl eq '') {
                   8905:                 $requrl = $ENV{'REQUEST_URI'};
                   8906:                 $requrl =~ s/\?.+$//;
                   8907:             }
                   8908:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   8909:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   8910:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   8911:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   8912:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   8913:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1075.2.145  raeburn  8914:                     my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1075.2.151  raeburn  8915:                     my ($offload,$offloadoth);
1.1075.2.89  raeburn  8916:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   8917:                         if ($domdefs{'offloadnow'}{$lonhost}) {
1.1075.2.145  raeburn  8918:                             $offload = 1;
1.1075.2.151  raeburn  8919:                             if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   8920:                                 (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   8921:                                 unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   8922:                                     $offloadoth = 1;
                   8923:                                     $dom_in_use = $env{'user.domain'};
                   8924:                                 }
                   8925:                             }
1.1075.2.145  raeburn  8926:                         }
                   8927:                     }
                   8928:                     unless ($offload) {
                   8929:                         if (ref($domdefs{'offloadoth'}) eq 'HASH') {
                   8930:                             if ($domdefs{'offloadoth'}{$lonhost}) {
                   8931:                                 if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   8932:                                     (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   8933:                                     unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   8934:                                         $offload = 1;
1.1075.2.151  raeburn  8935:                                         $offloadoth = 1;
1.1075.2.145  raeburn  8936:                                         $dom_in_use = $env{'user.domain'};
                   8937:                                     }
1.1075.2.89  raeburn  8938:                                 }
1.1075.2.145  raeburn  8939:                             }
                   8940:                         }
                   8941:                     }
                   8942:                     if ($offload) {
1.1075.2.158  raeburn  8943:                         my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1075.2.151  raeburn  8944:                         if (($newserver eq '') && ($offloadoth)) {
                   8945:                             my @domains = &Apache::lonnet::current_machine_domains();
1.1075.2.161.  .1(raebu 8946:21):                             if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
1.1075.2.151  raeburn  8947:                                 ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                   8948:                             }
                   8949:                         }
1.1075.2.145  raeburn  8950:                         if (($newserver) && ($newserver ne $lonhost)) {
                   8951:                             my $numsec = 5;
                   8952:                             my $timeout = $numsec * 1000;
                   8953:                             my ($newurl,$locknum,%locks,$msg);
                   8954:                             if ($env{'request.role.adv'}) {
                   8955:                                 ($locknum,%locks) = &Apache::lonnet::get_locks();
                   8956:                             }
                   8957:                             my $disable_submit = 0;
                   8958:                             if ($requrl =~ /$LONCAPA::assess_re/) {
                   8959:                                 $disable_submit = 1;
                   8960:                             }
                   8961:                             if ($locknum) {
                   8962:                                 my @lockinfo = sort(values(%locks));
1.1075.2.153  raeburn  8963:                                 $msg = &mt('Once the following tasks are complete:')." \n".
1.1075.2.145  raeburn  8964:                                        join(", ",sort(values(%locks)))."\n";
                   8965:                                 if (&show_course()) {
                   8966:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
1.1075.2.89  raeburn  8967:                                 } else {
1.1075.2.145  raeburn  8968:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
                   8969:                                 }
                   8970:                             } else {
                   8971:                                 if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   8972:                                     $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
                   8973:                                 }
                   8974:                                 $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   8975:                                 $newurl = '/adm/switchserver?otherserver='.$newserver;
                   8976:                                 if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   8977:                                     $newurl .= '&role='.$env{'request.role'};
                   8978:                                 }
                   8979:                                 if ($env{'request.symb'}) {
                   8980:                                     my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
                   8981:                                     if ($shownsymb =~ m{^/enc/}) {
                   8982:                                         my $reqdmajor = 2;
                   8983:                                         my $reqdminor = 11;
                   8984:                                         my $reqdsubminor = 3;
                   8985:                                         my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
                   8986:                                         my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
                   8987:                                         my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
                   8988:                                         if (($major eq '' && $minor eq '') ||
                   8989:                                             (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
                   8990:                                             (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
                   8991:                                              ($reqdsubminor > $subminor))))) {
                   8992:                                             undef($shownsymb);
                   8993:                                         }
1.1075.2.89  raeburn  8994:                                     }
1.1075.2.145  raeburn  8995:                                     if ($shownsymb) {
                   8996:                                         &js_escape(\$shownsymb);
                   8997:                                         $newurl .= '&symb='.$shownsymb;
1.1075.2.89  raeburn  8998:                                     }
1.1075.2.145  raeburn  8999:                                 } else {
                   9000:                                     my $shownurl = &Apache::lonenc::check_encrypt($requrl);
                   9001:                                     &js_escape(\$shownurl);
                   9002:                                     $newurl .= '&origurl='.$shownurl;
1.1075.2.89  raeburn  9003:                                 }
1.1075.2.145  raeburn  9004:                             }
                   9005:                             &js_escape(\$msg);
                   9006:                             $result.=<<OFFLOAD
1.1075.2.89  raeburn  9007: <meta http-equiv="pragma" content="no-cache" />
                   9008: <script type="text/javascript">
1.1075.2.92  raeburn  9009: // <![CDATA[
1.1075.2.89  raeburn  9010: function LC_Offload_Now() {
                   9011:     var dest = "$newurl";
                   9012:     if (dest != '') {
                   9013:         window.location.href="$newurl";
                   9014:     }
                   9015: }
1.1075.2.92  raeburn  9016: \$(document).ready(function () {
                   9017:     window.alert('$msg');
                   9018:     if ($disable_submit) {
1.1075.2.89  raeburn  9019:         \$(".LC_hwk_submit").prop("disabled", true);
                   9020:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92  raeburn  9021:     }
                   9022:     setTimeout('LC_Offload_Now()', $timeout);
                   9023: });
                   9024: // ]]>
1.1075.2.89  raeburn  9025: </script>
                   9026: OFFLOAD
                   9027:                         }
                   9028:                     }
                   9029:                 }
                   9030:             }
                   9031:         }
1.313     albertel 9032:     }
1.306     albertel 9033:     if (!defined($title)) {
                   9034: 	$title = 'The LearningOnline Network with CAPA';
                   9035:     }
1.460     albertel 9036:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   9037:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  9038: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   9039:     if (!$args->{'frameset'}) {
                   9040:         $result .= ' /';
                   9041:     }
                   9042:     $result .= '>'
1.1064    raeburn  9043:         .$inhibitprint
1.414     albertel 9044: 	.$head_extra;
1.1075.2.108  raeburn  9045:     my $clientmobile;
                   9046:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   9047:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   9048:     } else {
                   9049:         $clientmobile = $env{'browser.mobile'};
                   9050:     }
                   9051:     if ($clientmobile) {
1.1075.2.42  raeburn  9052:         $result .= '
                   9053: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   9054: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   9055:     }
1.1075.2.126  raeburn  9056:     $result .= '<meta name="google" content="notranslate" />'."\n";
1.962     droeschl 9057:     return $result.'</head>';
1.306     albertel 9058: }
                   9059: 
                   9060: =pod
                   9061: 
1.340     albertel 9062: =item * &font_settings()
                   9063: 
                   9064: Returns neccessary <meta> to set the proper encoding
                   9065: 
1.1075.2.56  raeburn  9066: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 9067: 
                   9068: =cut
                   9069: 
                   9070: sub font_settings {
1.1075.2.56  raeburn  9071:     my ($args) = @_;
1.340     albertel 9072:     my $headerstring='';
1.1075.2.56  raeburn  9073:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   9074:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 9075: 	$headerstring.=
1.1075.2.61  raeburn  9076: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   9077:         if (!$args->{'frameset'}) {
                   9078:             $headerstring.= ' /';
                   9079:         }
                   9080:         $headerstring .= '>'."\n";
1.340     albertel 9081:     }
                   9082:     return $headerstring;
                   9083: }
                   9084: 
1.341     albertel 9085: =pod
                   9086: 
1.1064    raeburn  9087: =item * &print_suppression()
                   9088: 
                   9089: In course context returns css which causes the body to be blank when media="print",
                   9090: if printout generation is unavailable for the current resource.
                   9091: 
                   9092: This could be because:
                   9093: 
                   9094: (a) printstartdate is in the future
                   9095: 
                   9096: (b) printenddate is in the past
                   9097: 
                   9098: (c) there is an active exam block with "printout"
                   9099: functionality blocked
                   9100: 
                   9101: Users with pav, pfo or evb privileges are exempt.
                   9102: 
                   9103: Inputs: none
                   9104: 
                   9105: =cut
                   9106: 
                   9107: 
                   9108: sub print_suppression {
                   9109:     my $noprint;
                   9110:     if ($env{'request.course.id'}) {
                   9111:         my $scope = $env{'request.course.id'};
                   9112:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   9113:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   9114:             return;
                   9115:         }
                   9116:         if ($env{'request.course.sec'} ne '') {
                   9117:             $scope .= "/$env{'request.course.sec'}";
                   9118:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   9119:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  9120:                 return;
1.1064    raeburn  9121:             }
                   9122:         }
                   9123:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9124:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.158  raeburn  9125:         my $clientip = &Apache::lonnet::get_requestor_ip();
                   9126:         my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064    raeburn  9127:         if ($blocked) {
                   9128:             my $checkrole = "cm./$cdom/$cnum";
                   9129:             if ($env{'request.course.sec'} ne '') {
                   9130:                 $checkrole .= "/$env{'request.course.sec'}";
                   9131:             }
                   9132:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   9133:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   9134:                 $noprint = 1;
                   9135:             }
                   9136:         }
                   9137:         unless ($noprint) {
                   9138:             my $symb = &Apache::lonnet::symbread();
                   9139:             if ($symb ne '') {
                   9140:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   9141:                 if (ref($navmap)) {
                   9142:                     my $res = $navmap->getBySymb($symb);
                   9143:                     if (ref($res)) {
                   9144:                         if (!$res->resprintable()) {
                   9145:                             $noprint = 1;
                   9146:                         }
                   9147:                     }
                   9148:                 }
                   9149:             }
                   9150:         }
                   9151:         if ($noprint) {
                   9152:             return <<"ENDSTYLE";
                   9153: <style type="text/css" media="print">
                   9154:     body { display:none }
                   9155: </style>
                   9156: ENDSTYLE
                   9157:         }
                   9158:     }
                   9159:     return;
                   9160: }
                   9161: 
                   9162: =pod
                   9163: 
1.341     albertel 9164: =item * &xml_begin()
                   9165: 
                   9166: Returns the needed doctype and <html>
                   9167: 
                   9168: Inputs: none
                   9169: 
                   9170: =cut
                   9171: 
                   9172: sub xml_begin {
1.1075.2.61  raeburn  9173:     my ($is_frameset) = @_;
1.341     albertel 9174:     my $output='';
                   9175: 
                   9176:     if ($env{'browser.mathml'}) {
                   9177: 	$output='<?xml version="1.0"?>'
                   9178:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   9179: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   9180:             
                   9181: #	    .'<!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">] >'
                   9182: 	    .'<!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">'
                   9183:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   9184: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  9185:     } elsif ($is_frameset) {
                   9186:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   9187:                 '<html>'."\n";
1.341     albertel 9188:     } else {
1.1075.2.61  raeburn  9189: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   9190:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 9191:     }
                   9192:     return $output;
                   9193: }
1.340     albertel 9194: 
                   9195: =pod
                   9196: 
1.306     albertel 9197: =item * &start_page()
                   9198: 
                   9199: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   9200: 
1.648     raeburn  9201: Inputs:
                   9202: 
                   9203: =over 4
                   9204: 
                   9205: $title - optional title for the page
                   9206: 
                   9207: $head_extra - optional extra HTML to incude inside the <head>
                   9208: 
                   9209: $args - additional optional args supported are:
                   9210: 
                   9211: =over 8
                   9212: 
                   9213:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 9214:                                     arg on
1.814     bisitz   9215:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  9216:              add_entries    -> additional attributes to add to the  <body>
                   9217:              domain         -> force to color decorate a page for a 
1.317     albertel 9218:                                     specific domain
1.648     raeburn  9219:              function       -> force usage of a specific rolish color
1.317     albertel 9220:                                     scheme
1.648     raeburn  9221:              redirect       -> see &headtag()
                   9222:              bgcolor        -> override the default page bg color
                   9223:              js_ready       -> return a string ready for being used in 
1.317     albertel 9224:                                     a javascript writeln
1.648     raeburn  9225:              html_encode    -> return a string ready for being used in 
1.320     albertel 9226:                                     a html attribute
1.648     raeburn  9227:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 9228:                                     $forcereg arg
1.648     raeburn  9229:              frameset       -> if true will start with a <frameset>
1.330     albertel 9230:                                     rather than <body>
1.648     raeburn  9231:              skip_phases    -> hash ref of 
1.338     albertel 9232:                                     head -> skip the <html><head> generation
                   9233:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  9234:              no_inline_link -> if true and in remote mode, don't show the
                   9235:                                     'Switch To Inline Menu' link
1.648     raeburn  9236:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 9237:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  9238:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.123  raeburn  9239:              bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                   9240:                                     to lonhtmlcommon::breadcrumbs
1.1075.2.15  raeburn  9241:              group          -> includes the current group, if page is for a
                   9242:                                specific group
1.1075.2.133  raeburn  9243:              use_absolute   -> for request for external resource or syllabus, this
                   9244:                                will contain https://<hostname> if server uses
                   9245:                                https (as per hosts.tab), but request is for http
                   9246:              hostname       -> hostname, originally from $r->hostname(), (optional).
1.1075.2.158  raeburn  9247:              links_disabled -> Links in primary and secondary menus are disabled
                   9248:                                (Can enable them once page has loaded - see lonroles.pm
                   9249:                                for an example).
1.1075.2.161.  .6(raebu 9250:22):              links_target   -> Target for links, e.g., _parent (optional).
1.361     albertel 9251: 
1.648     raeburn  9252: =back
1.460     albertel 9253: 
1.648     raeburn  9254: =back
1.562     albertel 9255: 
1.306     albertel 9256: =cut
                   9257: 
                   9258: sub start_page {
1.309     albertel 9259:     my ($title,$head_extra,$args) = @_;
1.318     albertel 9260:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 9261: 
1.315     albertel 9262:     $env{'internal.start_page'}++;
1.1075.2.161.  .1(raebu 9263:21):     my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964     droeschl 9264: 
1.338     albertel 9265:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  9266:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 9267:     }
1.1075.2.161.  .1(raebu 9268:21): 
                   9269:21):     if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
                   9270:21):         if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
                   9271:21):             unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
                   9272:21):                 $args->{'no_primary_menu'} = 1;
                   9273:21):             }
                   9274:21):             unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
                   9275:21):                 $args->{'no_inline_menu'} = 1;
                   9276:21):             }
                   9277:21):             if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
                   9278:21):                 map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
                   9279:21):             }
                   9280:21):         } else {
                   9281:21):             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9282:21):             my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
                   9283:21):             if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
                   9284:21):                 unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
                   9285:21):                     $args->{'no_primary_menu'} = 1;
                   9286:21):                 }
                   9287:21):                 unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
                   9288:21):                     $args->{'no_inline_menu'} = 1;
                   9289:21):                 }
                   9290:21):                 if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
                   9291:21):                     map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
                   9292:21):                 }
                   9293:21):             }
                   9294:21):         }
                   9295:21):         ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
                   9296:21):                                   $env{'course.'.$env{'request.course.id'}.'.domain'},
                   9297:21):                                   $env{'course.'.$env{'request.course.id'}.'.num'});
                   9298:21):     } elsif ($env{'request.course.id'}) {
                   9299:21):         my $expiretime=600;
                   9300:21):         if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
                   9301:21):             &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
                   9302:21):         }
                   9303:21):         my ($deeplinkmenu,$menuref);
                   9304:21):         ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
                   9305:21):         if ($menucoll) {
                   9306:21):             if (ref($menuref) eq 'HASH') {
                   9307:21):                 %menu = %{$menuref};
                   9308:21):             }
                   9309:21):             if ($menu{'top'} eq 'n') {
                   9310:21):                 $args->{'no_primary_menu'} = 1;
                   9311:21):             }
                   9312:21):             if ($menu{'inline'} eq 'n') {
                   9313:21):                 unless (&Apache::lonnet::allowed('opa')) {
                   9314:21):                     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9315:21):                     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9316:21):                     my $crstype = &course_type();
                   9317:21):                     my $now = time;
                   9318:21):                     my $ccrole;
                   9319:21):                     if ($crstype eq 'Community') {
                   9320:21):                         $ccrole = 'co';
                   9321:21):                     } else {
                   9322:21):                         $ccrole = 'cc';
                   9323:21):                     }
                   9324:21):                     if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
                   9325:21):                         my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
                   9326:21):                         if ((($start) && ($start<0)) ||
                   9327:21):                             (($end) && ($end<$now))  ||
                   9328:21):                             (($start) && ($now<$start))) {
                   9329:21):                             $args->{'no_inline_menu'} = 1;
                   9330:21):                         }
                   9331:21):                     } else {
                   9332:21):                         $args->{'no_inline_menu'} = 1;
                   9333:21):                     }
                   9334:21):                 }
                   9335:21):             }
                   9336:21):         }
                   9337:21):     }
          .4(raebu 9338:22): 
          .8(raebu 9339:22):     my $showncrumbs;
1.338     albertel 9340:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   9341: 	if ($args->{'frameset'}) {
                   9342: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   9343: 						$args->{'add_entries'});
                   9344: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   9345:         } else {
                   9346:             $result .=
                   9347:                 &bodytag($title, 
                   9348:                          $args->{'function'},       $args->{'add_entries'},
                   9349:                          $args->{'only_body'},      $args->{'domain'},
                   9350:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  9351:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.161.  .1(raebu 9352:21):                          $args,                     \@advtools,
          .8(raebu 9353:22):                          $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu,\$showncrumbs);
1.831     bisitz   9354:         }
1.330     albertel 9355:     }
1.338     albertel 9356: 
1.315     albertel 9357:     if ($args->{'js_ready'}) {
1.713     kaisler  9358: 		$result = &js_ready($result);
1.315     albertel 9359:     }
1.320     albertel 9360:     if ($args->{'html_encode'}) {
1.713     kaisler  9361: 		$result = &html_encode($result);
                   9362:     }
                   9363: 
1.813     bisitz   9364:     # Preparation for new and consistent functionlist at top of screen
                   9365:     # if ($args->{'functionlist'}) {
                   9366:     #            $result .= &build_functionlist();
                   9367:     #}
                   9368: 
1.964     droeschl 9369:     # Don't add anything more if only_body wanted or in const space
                   9370:     return $result if    $args->{'only_body'} 
                   9371:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   9372: 
                   9373:     #Breadcrumbs
1.758     kaisler  9374:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1075.2.161.  .8(raebu 9375:22):         unless ($showncrumbs) {
1.758     kaisler  9376: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   9377: 		#if any br links exists, add them to the breadcrumbs
                   9378: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   9379: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   9380: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   9381: 			}
                   9382: 		}
1.1075.2.19  raeburn  9383:                 # if @advtools array contains items add then to the breadcrumbs
                   9384:                 if (@advtools > 0) {
                   9385:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   9386:                 }
1.1075.2.123  raeburn  9387:                 my $menulink;
                   9388:                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
1.1075.2.161.  .1(raebu 9389:21):                 if ((exists($args->{'bread_crumbs_nomenu'})) ||
                   9390:21):                     ($ltiscope eq 'map') || ($ltiscope eq 'resource')) {
1.1075.2.123  raeburn  9391:                     $menulink = 0;
                   9392:                 } else {
                   9393:                     undef($menulink);
                   9394:                 }
1.1075.2.161.  .8(raebu 9395:22):                 my $linkprotout;
                   9396:22):                 if ($env{'request.deeplink.login'}) {
                   9397:22):                     my $linkprotout = &Apache::lonmenu::linkprot_exit();
                   9398:22):                     if ($linkprotout) {
                   9399:22):                         &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
                   9400:22):                     }
                   9401:22):                 }
1.758     kaisler  9402: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   9403: 		if(exists($args->{'bread_crumbs_component'})){
1.1075.2.123  raeburn  9404: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1075.2.161.  .1(raebu 9405:21): 		} else {
1.1075.2.123  raeburn  9406: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758     kaisler  9407: 		}
1.1075.2.161.  .8(raebu 9408:22):         }
1.1075.2.24  raeburn  9409:     } elsif (($env{'environment.remote'} eq 'on') &&
                   9410:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   9411:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   9412:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  9413:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 9414:     }
1.315     albertel 9415:     return $result;
1.306     albertel 9416: }
                   9417: 
                   9418: sub end_page {
1.315     albertel 9419:     my ($args) = @_;
                   9420:     $env{'internal.end_page'}++;
1.330     albertel 9421:     my $result;
1.335     albertel 9422:     if ($args->{'discussion'}) {
                   9423: 	my ($target,$parser);
                   9424: 	if (ref($args->{'discussion'})) {
                   9425: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   9426: 				$args->{'discussion'}{'parser'});
                   9427: 	}
                   9428: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   9429:     }
1.330     albertel 9430:     if ($args->{'frameset'}) {
                   9431: 	$result .= '</frameset>';
                   9432:     } else {
1.635     raeburn  9433: 	$result .= &endbodytag($args);
1.330     albertel 9434:     }
1.1075.2.6  raeburn  9435:     unless ($args->{'notbody'}) {
                   9436:         $result .= "\n</html>";
                   9437:     }
1.330     albertel 9438: 
1.315     albertel 9439:     if ($args->{'js_ready'}) {
1.317     albertel 9440: 	$result = &js_ready($result);
1.315     albertel 9441:     }
1.335     albertel 9442: 
1.320     albertel 9443:     if ($args->{'html_encode'}) {
                   9444: 	$result = &html_encode($result);
                   9445:     }
1.335     albertel 9446: 
1.315     albertel 9447:     return $result;
                   9448: }
                   9449: 
1.1075.2.161.  .1(raebu 9450:21): sub menucoll_in_effect {
                   9451:21):     my ($menucoll,$deeplinkmenu,%menu);
                   9452:21):     if ($env{'request.course.id'}) {
                   9453:21):         $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
                   9454:21):         if ($env{'request.deeplink.login'}) {
                   9455:21):             my ($deeplink_symb,$deeplink,$check_login_symb);
                   9456:21):             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9457:21):             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9458:21):             if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
                   9459:21):                 if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
                   9460:21):                     my $navmap = Apache::lonnavmaps::navmap->new();
                   9461:21):                     if (ref($navmap)) {
                   9462:21):                         $deeplink = $navmap->get_mapparam(undef,
                   9463:21):                                                           &Apache::lonnet::declutter($env{'request.noversionuri'}),
                   9464:21):                                                           '0.deeplink');
                   9465:21):                     } else {
                   9466:21):                         $check_login_symb = 1;
                   9467:21):                     }
                   9468:21):                 } else {
                   9469:21):                     my $symb=&Apache::lonnet::symbread();
                   9470:21):                     if ($symb) {
                   9471:21):                         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
                   9472:21):                     } else {
                   9473:21):                         $check_login_symb = 1;
                   9474:21):                     }
                   9475:21):                 }
                   9476:21):             } else {
                   9477:21):                 $check_login_symb = 1;
                   9478:21):             }
                   9479:21):             if ($check_login_symb) {
                   9480:21):                 $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
                   9481:21):                 if ($deeplink_symb =~ /\.(page|sequence)$/) {
                   9482:21):                     my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
                   9483:21):                     my $navmap = Apache::lonnavmaps::navmap->new();
                   9484:21):                     if (ref($navmap)) {
                   9485:21):                         $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
                   9486:21):                     }
                   9487:21):                 } else {
                   9488:21):                     $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
                   9489:21):                 }
                   9490:21):             }
                   9491:21):             if ($deeplink ne '') {
          .6(raebu 9492:22):                 my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
          .1(raebu 9493:21):                 if ($display =~ /^\d+$/) {
                   9494:21):                     $deeplinkmenu = 1;
                   9495:21):                     $menucoll = $display;
                   9496:21):                 }
                   9497:21):             }
                   9498:21):         }
                   9499:21):         if ($menucoll) {
                   9500:21):             %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
                   9501:21):         }
                   9502:21):     }
                   9503:21):     return ($menucoll,$deeplinkmenu,\%menu);
                   9504:21): }
                   9505:21): 
                   9506:21): sub deeplink_login_symb {
                   9507:21):     my ($cnum,$cdom) = @_;
                   9508:21):     my $login_symb;
                   9509:21):     if ($env{'request.deeplink.login'}) {
                   9510:21):         $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
                   9511:21):     }
                   9512:21):     return $login_symb;
                   9513:21): }
                   9514:21): 
                   9515:21): sub symb_from_tinyurl {
                   9516:21):     my ($url,$cnum,$cdom) = @_;
                   9517:21):     if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
                   9518:21):         my $key = $1;
                   9519:21):         my ($tinyurl,$login);
                   9520:21):         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
                   9521:21):         if (defined($cached)) {
                   9522:21):             $tinyurl = $result;
                   9523:21):         } else {
                   9524:21):             my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                   9525:21):             my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
                   9526:21):             if ($currtiny{$key} ne '') {
                   9527:21):                 $tinyurl = $currtiny{$key};
                   9528:21):                 &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
                   9529:21):             }
                   9530:21):         }
                   9531:21):         if ($tinyurl ne '') {
                   9532:21):             my ($cnumreq,$symb) = split(/\&/,$tinyurl);
                   9533:21):             if (wantarray) {
                   9534:21):                 return ($cnumreq,$symb);
                   9535:21):             } elsif ($cnumreq eq $cnum) {
                   9536:21):                 return $symb;
                   9537:21):             }
                   9538:21):         }
                   9539:21):     }
                   9540:21):     if (wantarray) {
                   9541:21):         return ();
                   9542:21):     } else {
                   9543:21):         return;
                   9544:21):     }
                   9545:21): }
                   9546:21): 
          .17(raeb 9547:-23): sub usable_exttools {
                   9548:-23):     my %tooltypes;
                   9549:-23):     if ($env{'request.course.id'}) {
                   9550:-23):         if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
                   9551:-23):            if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
                   9552:-23):                %tooltypes = (
                   9553:-23):                              crs => 1,
                   9554:-23):                              dom => 1,
                   9555:-23):                             );
                   9556:-23):            } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
                   9557:-23):                $tooltypes{'crs'} = 1;
                   9558:-23):            } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
                   9559:-23):                $tooltypes{'dom'} = 1;
                   9560:-23):            }
                   9561:-23):         } else {
                   9562:-23):             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9563:-23):             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9564:-23):             my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
                   9565:-23):             if ($crstype eq '') {
                   9566:-23):                 $crstype = 'course';
                   9567:-23):             }
                   9568:-23):             if ($crstype eq 'course') {
                   9569:-23):                 if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
                   9570:-23):                     $crstype = 'official';
                   9571:-23):                 } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
                   9572:-23):                     $crstype = 'textbook';
                   9573:-23):                 } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
                   9574:-23):                     $crstype = 'lti';
                   9575:-23):                 } else {
                   9576:-23):                     $crstype = 'unofficial';
                   9577:-23):                 }
                   9578:-23):             }
                   9579:-23):             my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
                   9580:-23):             if ($domdefaults{$crstype.'domexttool'}) {
                   9581:-23):                 $tooltypes{'dom'} = 1;
                   9582:-23):             }
                   9583:-23):             if ($domdefaults{$crstype.'exttool'}) {
                   9584:-23):                 $tooltypes{'crs'} = 1;
                   9585:-23):             }
                   9586:-23):         }
                   9587:-23):     }
                   9588:-23):     return %tooltypes;
                   9589:-23): }
                   9590:-23): 
1.1034    www      9591: sub wishlist_window {
                   9592:     return(<<'ENDWISHLIST');
1.1046    raeburn  9593: <script type="text/javascript">
1.1034    www      9594: // <![CDATA[
                   9595: // <!-- BEGIN LON-CAPA Internal
                   9596: function set_wishlistlink(title, path) {
                   9597:     if (!title) {
                   9598:         title = document.title;
                   9599:         title = title.replace(/^LON-CAPA /,'');
                   9600:     }
1.1075.2.65  raeburn  9601:     title = encodeURIComponent(title);
1.1075.2.83  raeburn  9602:     title = title.replace("'","\\\'");
1.1034    www      9603:     if (!path) {
                   9604:         path = location.pathname;
                   9605:     }
1.1075.2.65  raeburn  9606:     path = encodeURIComponent(path);
1.1075.2.83  raeburn  9607:     path = path.replace("'","\\\'");
1.1034    www      9608:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   9609:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   9610: }
                   9611: // END LON-CAPA Internal -->
                   9612: // ]]>
                   9613: </script>
                   9614: ENDWISHLIST
                   9615: }
                   9616: 
1.1030    www      9617: sub modal_window {
                   9618:     return(<<'ENDMODAL');
1.1046    raeburn  9619: <script type="text/javascript">
1.1030    www      9620: // <![CDATA[
                   9621: // <!-- BEGIN LON-CAPA Internal
                   9622: var modalWindow = {
                   9623: 	parent:"body",
                   9624: 	windowId:null,
                   9625: 	content:null,
                   9626: 	width:null,
                   9627: 	height:null,
                   9628: 	close:function()
                   9629: 	{
                   9630: 	        $(".LCmodal-window").remove();
                   9631: 	        $(".LCmodal-overlay").remove();
                   9632: 	},
                   9633: 	open:function()
                   9634: 	{
                   9635: 		var modal = "";
                   9636: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   9637: 		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;\">";
                   9638: 		modal += this.content;
                   9639: 		modal += "</div>";	
                   9640: 
                   9641: 		$(this.parent).append(modal);
                   9642: 
                   9643: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   9644: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   9645: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   9646: 	}
                   9647: };
1.1075.2.42  raeburn  9648: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      9649: 	{
1.1075.2.119  raeburn  9650:                 source = source.replace(/'/g,"&#39;");
1.1030    www      9651: 		modalWindow.windowId = "myModal";
                   9652: 		modalWindow.width = width;
                   9653: 		modalWindow.height = height;
1.1075.2.80  raeburn  9654: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      9655: 		modalWindow.open();
1.1075.2.87  raeburn  9656: 	};
1.1030    www      9657: // END LON-CAPA Internal -->
                   9658: // ]]>
                   9659: </script>
                   9660: ENDMODAL
                   9661: }
                   9662: 
                   9663: sub modal_link {
1.1075.2.42  raeburn  9664:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      9665:     unless ($width) { $width=480; }
                   9666:     unless ($height) { $height=400; }
1.1031    www      9667:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  9668:     unless ($transparency) { $transparency='true'; }
                   9669: 
1.1074    raeburn  9670:     my $target_attr;
                   9671:     if (defined($target)) {
                   9672:         $target_attr = 'target="'.$target.'"';
                   9673:     }
                   9674:     return <<"ENDLINK";
1.1075.2.143  raeburn  9675: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074    raeburn  9676: ENDLINK
1.1030    www      9677: }
                   9678: 
1.1032    www      9679: sub modal_adhoc_script {
1.1075.2.155  raeburn  9680:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
                   9681:     my $mathjax;
                   9682:     if ($possmathjax) {
                   9683:         $mathjax = <<'ENDJAX';
                   9684:                if (typeof MathJax == 'object') {
                   9685:                    MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
                   9686:                }
                   9687: ENDJAX
                   9688:     }
1.1032    www      9689:     return (<<ENDADHOC);
1.1046    raeburn  9690: <script type="text/javascript">
1.1032    www      9691: // <![CDATA[
                   9692:         var $funcname = function()
                   9693:         {
                   9694:                 modalWindow.windowId = "myModal";
                   9695:                 modalWindow.width = $width;
                   9696:                 modalWindow.height = $height;
                   9697:                 modalWindow.content = '$content';
                   9698:                 modalWindow.open();
1.1075.2.155  raeburn  9699:                 $mathjax
1.1032    www      9700:         };  
                   9701: // ]]>
                   9702: </script>
                   9703: ENDADHOC
                   9704: }
                   9705: 
1.1041    www      9706: sub modal_adhoc_inner {
1.1075.2.155  raeburn  9707:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041    www      9708:     my $innerwidth=$width-20;
                   9709:     $content=&js_ready(
1.1042    www      9710:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  9711:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   9712:                  $content.
1.1041    www      9713:                  &end_scrollbox().
1.1075.2.42  raeburn  9714:                  &end_page()
1.1041    www      9715:              );
1.1075.2.155  raeburn  9716:     return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041    www      9717: }
                   9718: 
                   9719: sub modal_adhoc_window {
1.1075.2.155  raeburn  9720:     my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
                   9721:     return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041    www      9722:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   9723: }
                   9724: 
                   9725: sub modal_adhoc_launch {
                   9726:     my ($funcname,$width,$height,$content)=@_;
                   9727:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   9728: <script type="text/javascript">
                   9729: // <![CDATA[
                   9730: $funcname();
                   9731: // ]]>
                   9732: </script>
                   9733: ENDLAUNCH
                   9734: }
                   9735: 
                   9736: sub modal_adhoc_close {
                   9737:     return (<<ENDCLOSE);
                   9738: <script type="text/javascript">
                   9739: // <![CDATA[
                   9740: modalWindow.close();
                   9741: // ]]>
                   9742: </script>
                   9743: ENDCLOSE
                   9744: }
                   9745: 
1.1038    www      9746: sub togglebox_script {
                   9747:    return(<<ENDTOGGLE);
                   9748: <script type="text/javascript"> 
                   9749: // <![CDATA[
                   9750: function LCtoggleDisplay(id,hidetext,showtext) {
                   9751:    link = document.getElementById(id + "link").childNodes[0];
                   9752:    with (document.getElementById(id).style) {
                   9753:       if (display == "none" ) {
                   9754:           display = "inline";
                   9755:           link.nodeValue = hidetext;
                   9756:         } else {
                   9757:           display = "none";
                   9758:           link.nodeValue = showtext;
                   9759:        }
                   9760:    }
                   9761: }
                   9762: // ]]>
                   9763: </script>
                   9764: ENDTOGGLE
                   9765: }
                   9766: 
1.1039    www      9767: sub start_togglebox {
                   9768:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   9769:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   9770:     unless ($showtext) { $showtext=&mt('show'); }
                   9771:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   9772:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   9773:     return &start_data_table().
                   9774:            &start_data_table_header_row().
                   9775:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   9776:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   9777:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   9778:            &end_data_table_header_row().
                   9779:            '<tr id="'.$id.'" style="display:none""><td>';
                   9780: }
                   9781: 
                   9782: sub end_togglebox {
                   9783:     return '</td></tr>'.&end_data_table();
                   9784: }
                   9785: 
1.1041    www      9786: sub LCprogressbar_script {
1.1075.2.130  raeburn  9787:    my ($id,$number_to_do)=@_;
                   9788:    if ($number_to_do) {
                   9789:        return(<<ENDPROGRESS);
1.1041    www      9790: <script type="text/javascript">
                   9791: // <![CDATA[
1.1045    www      9792: \$('#progressbar$id').progressbar({
1.1041    www      9793:   value: 0,
                   9794:   change: function(event, ui) {
                   9795:     var newVal = \$(this).progressbar('option', 'value');
                   9796:     \$('.pblabel', this).text(LCprogressTxt);
                   9797:   }
                   9798: });
                   9799: // ]]>
                   9800: </script>
                   9801: ENDPROGRESS
1.1075.2.130  raeburn  9802:    } else {
                   9803:        return(<<ENDPROGRESS);
                   9804: <script type="text/javascript">
                   9805: // <![CDATA[
                   9806: \$('#progressbar$id').progressbar({
                   9807:   value: false,
                   9808:   create: function(event, ui) {
                   9809:     \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
                   9810:     \$('.ui-progressbar-overlay', this).css({'margin':'0'});
                   9811:   }
                   9812: });
                   9813: // ]]>
                   9814: </script>
                   9815: ENDPROGRESS
                   9816:    }
1.1041    www      9817: }
                   9818: 
                   9819: sub LCprogressbarUpdate_script {
                   9820:    return(<<ENDPROGRESSUPDATE);
                   9821: <style type="text/css">
                   9822: .ui-progressbar { position:relative; }
1.1075.2.130  raeburn  9823: .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      9824: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   9825: </style>
                   9826: <script type="text/javascript">
                   9827: // <![CDATA[
1.1045    www      9828: var LCprogressTxt='---';
                   9829: 
1.1075.2.130  raeburn  9830: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041    www      9831:    LCprogressTxt=progresstext;
1.1075.2.130  raeburn  9832:    if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
                   9833:        \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
                   9834:    } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
                   9835:        \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
                   9836:    } else {
                   9837:        \$('#progressbar'+id).progressbar('value',percent);
                   9838:    }
1.1041    www      9839: }
                   9840: // ]]>
                   9841: </script>
                   9842: ENDPROGRESSUPDATE
                   9843: }
                   9844: 
1.1042    www      9845: my $LClastpercent;
1.1045    www      9846: my $LCidcnt;
                   9847: my $LCcurrentid;
1.1042    www      9848: 
1.1041    www      9849: sub LCprogressbar {
1.1075.2.130  raeburn  9850:     my ($r,$number_to_do,$preamble)=@_;
1.1042    www      9851:     $LClastpercent=0;
1.1045    www      9852:     $LCidcnt++;
                   9853:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1075.2.130  raeburn  9854:     my ($starting,$content);
                   9855:     if ($number_to_do) {
                   9856:         $starting=&mt('Starting');
                   9857:         $content=(<<ENDPROGBAR);
                   9858: $preamble
1.1045    www      9859:   <div id="progressbar$LCcurrentid">
1.1041    www      9860:     <span class="pblabel">$starting</span>
                   9861:   </div>
                   9862: ENDPROGBAR
1.1075.2.130  raeburn  9863:     } else {
                   9864:         $starting=&mt('Loading...');
                   9865:         $LClastpercent='false';
                   9866:         $content=(<<ENDPROGBAR);
                   9867: $preamble
                   9868:   <div id="progressbar$LCcurrentid">
                   9869:       <div class="progress-label">$starting</div>
                   9870:   </div>
                   9871: ENDPROGBAR
                   9872:     }
                   9873:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041    www      9874: }
                   9875: 
                   9876: sub LCprogressbarUpdate {
1.1075.2.130  raeburn  9877:     my ($r,$val,$text,$number_to_do)=@_;
                   9878:     if ($number_to_do) {
                   9879:         unless ($val) { 
                   9880:             if ($LClastpercent) {
                   9881:                 $val=$LClastpercent;
                   9882:             } else {
                   9883:                 $val=0;
                   9884:             }
                   9885:         }
                   9886:         if ($val<0) { $val=0; }
                   9887:         if ($val>100) { $val=0; }
                   9888:         $LClastpercent=$val;
                   9889:         unless ($text) { $text=$val.'%'; }
                   9890:     } else {
                   9891:         $val = 'false';
1.1042    www      9892:     }
1.1041    www      9893:     $text=&js_ready($text);
1.1044    www      9894:     &r_print($r,<<ENDUPDATE);
1.1041    www      9895: <script type="text/javascript">
                   9896: // <![CDATA[
1.1075.2.130  raeburn  9897: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041    www      9898: // ]]>
                   9899: </script>
                   9900: ENDUPDATE
1.1035    www      9901: }
                   9902: 
1.1042    www      9903: sub LCprogressbarClose {
                   9904:     my ($r)=@_;
                   9905:     $LClastpercent=0;
1.1044    www      9906:     &r_print($r,<<ENDCLOSE);
1.1042    www      9907: <script type="text/javascript">
                   9908: // <![CDATA[
1.1045    www      9909: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      9910: // ]]>
                   9911: </script>
                   9912: ENDCLOSE
1.1044    www      9913: }
                   9914: 
                   9915: sub r_print {
                   9916:     my ($r,$to_print)=@_;
                   9917:     if ($r) {
                   9918:       $r->print($to_print);
                   9919:       $r->rflush();
                   9920:     } else {
                   9921:       print($to_print);
                   9922:     }
1.1042    www      9923: }
                   9924: 
1.320     albertel 9925: sub html_encode {
                   9926:     my ($result) = @_;
                   9927: 
1.322     albertel 9928:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 9929:     
                   9930:     return $result;
                   9931: }
1.1044    www      9932: 
1.317     albertel 9933: sub js_ready {
                   9934:     my ($result) = @_;
                   9935: 
1.323     albertel 9936:     $result =~ s/[\n\r]/ /xmsg;
                   9937:     $result =~ s/\\/\\\\/xmsg;
                   9938:     $result =~ s/'/\\'/xmsg;
1.372     albertel 9939:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 9940:     
                   9941:     return $result;
                   9942: }
                   9943: 
1.315     albertel 9944: sub validate_page {
                   9945:     if (  exists($env{'internal.start_page'})
1.316     albertel 9946: 	  &&     $env{'internal.start_page'} > 1) {
                   9947: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 9948: 				 $env{'internal.start_page'}.' '.
1.316     albertel 9949: 				 $ENV{'request.filename'});
1.315     albertel 9950:     }
                   9951:     if (  exists($env{'internal.end_page'})
1.316     albertel 9952: 	  &&     $env{'internal.end_page'} > 1) {
                   9953: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 9954: 				 $env{'internal.end_page'}.' '.
1.316     albertel 9955: 				 $env{'request.filename'});
1.315     albertel 9956:     }
                   9957:     if (     exists($env{'internal.start_page'})
                   9958: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 9959: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   9960: 				 $env{'request.filename'});
1.315     albertel 9961:     }
                   9962:     if (   ! exists($env{'internal.start_page'})
                   9963: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 9964: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   9965: 				 $env{'request.filename'});
1.315     albertel 9966:     }
1.306     albertel 9967: }
1.315     albertel 9968: 
1.996     www      9969: 
                   9970: sub start_scrollbox {
1.1075.2.56  raeburn  9971:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  9972:     unless ($outerwidth) { $outerwidth='520px'; }
                   9973:     unless ($width) { $width='500px'; }
                   9974:     unless ($height) { $height='200px'; }
1.1075    raeburn  9975:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  9976:     if ($id ne '') {
1.1075.2.42  raeburn  9977:         $table_id = ' id="table_'.$id.'"';
                   9978:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  9979:     }
1.1075    raeburn  9980:     if ($bgcolor ne '') {
                   9981:         $tdcol = "background-color: $bgcolor;";
                   9982:     }
1.1075.2.42  raeburn  9983:     my $nicescroll_js;
                   9984:     if ($env{'browser.mobile'}) {
                   9985:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   9986:     }
1.1075    raeburn  9987:     return <<"END";
1.1075.2.42  raeburn  9988: $nicescroll_js
                   9989: 
                   9990: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  9991: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  9992: END
1.996     www      9993: }
                   9994: 
                   9995: sub end_scrollbox {
1.1036    www      9996:     return '</div></td></tr></table>';
1.996     www      9997: }
                   9998: 
1.1075.2.42  raeburn  9999: sub nicescroll_javascript {
                   10000:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   10001:     my %options;
                   10002:     if (ref($cursor) eq 'HASH') {
                   10003:         %options = %{$cursor};
                   10004:     }
                   10005:     unless ($options{'railalign'} =~ /^left|right$/) {
                   10006:         $options{'railalign'} = 'left';
                   10007:     }
                   10008:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   10009:         my $function  = &get_users_function();
                   10010:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   10011:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   10012:             $options{'cursorcolor'} = '#00F';
                   10013:         }
                   10014:     }
                   10015:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   10016:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   10017:             $options{'cursoropacity'}='1.0';
                   10018:         }
                   10019:     } else {
                   10020:         $options{'cursoropacity'}='1.0';
                   10021:     }
                   10022:     if ($options{'cursorfixedheight'} eq 'none') {
                   10023:         delete($options{'cursorfixedheight'});
                   10024:     } else {
                   10025:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   10026:     }
                   10027:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   10028:         delete($options{'railoffset'});
                   10029:     }
                   10030:     my @niceoptions;
                   10031:     while (my($key,$value) = each(%options)) {
                   10032:         if ($value =~ /^\{.+\}$/) {
                   10033:             push(@niceoptions,$key.':'.$value);
                   10034:         } else {
                   10035:             push(@niceoptions,$key.':"'.$value.'"');
                   10036:         }
                   10037:     }
                   10038:     my $nicescroll_js = '
                   10039: $(document).ready(
                   10040:       function() {
                   10041:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   10042:       }
                   10043: );
                   10044: ';
                   10045:     if ($framecheck) {
                   10046:         $nicescroll_js .= '
                   10047: function expand_div(caller) {
                   10048:     if (top === self) {
                   10049:         document.getElementById("'.$id.'").style.width = "auto";
                   10050:         document.getElementById("'.$id.'").style.height = "auto";
                   10051:     } else {
                   10052:         try {
                   10053:             if (parent.frames) {
                   10054:                 if (parent.frames.length > 1) {
                   10055:                     var framesrc = parent.frames[1].location.href;
                   10056:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   10057:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   10058:                         document.getElementById("'.$id.'").style.width = "auto";
                   10059:                         document.getElementById("'.$id.'").style.height = "auto";
                   10060:                     }
                   10061:                 }
                   10062:             }
                   10063:         } catch (e) {
                   10064:             return;
                   10065:         }
                   10066:     }
                   10067:     return;
                   10068: }
                   10069: ';
                   10070:     }
                   10071:     if ($needjsready) {
                   10072:         $nicescroll_js = '
                   10073: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   10074:     } else {
                   10075:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   10076:     }
                   10077:     return $nicescroll_js;
                   10078: }
                   10079: 
1.318     albertel 10080: sub simple_error_page {
1.1075.2.49  raeburn  10081:     my ($r,$title,$msg,$args) = @_;
1.1075.2.161.  .4(raebu 10082:22):     my %displayargs;
1.1075.2.49  raeburn  10083:     if (ref($args) eq 'HASH') {
                   10084:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1075.2.161.  .4(raebu 10085:22):         if ($args->{'only_body'}) {
                   10086:22):             $displayargs{'only_body'} = 1;
                   10087:22):         }
                   10088:22):         if ($args->{'no_nav_bar'}) {
                   10089:22):             $displayargs{'no_nav_bar'} = 1;
                   10090:22):         }
1.1075.2.49  raeburn  10091:     } else {
                   10092:         $msg = &mt($msg);
                   10093:     }
                   10094: 
1.318     albertel 10095:     my $page =
1.1075.2.161.  .4(raebu 10096:22): 	&Apache::loncommon::start_page($title,'',\%displayargs).
1.1075.2.49  raeburn  10097: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 10098: 	&Apache::loncommon::end_page();
                   10099:     if (ref($r)) {
                   10100: 	$r->print($page);
1.327     albertel 10101: 	return;
1.318     albertel 10102:     }
                   10103:     return $page;
                   10104: }
1.347     albertel 10105: 
                   10106: {
1.610     albertel 10107:     my @row_count;
1.961     onken    10108: 
                   10109:     sub start_data_table_count {
                   10110:         unshift(@row_count, 0);
                   10111:         return;
                   10112:     }
                   10113: 
                   10114:     sub end_data_table_count {
                   10115:         shift(@row_count);
                   10116:         return;
                   10117:     }
                   10118: 
1.347     albertel 10119:     sub start_data_table {
1.1018    raeburn  10120: 	my ($add_class,$id) = @_;
1.422     albertel 10121: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  10122:         my $table_id;
                   10123:         if (defined($id)) {
                   10124:             $table_id = ' id="'.$id.'"';
                   10125:         }
1.961     onken    10126: 	&start_data_table_count();
1.1018    raeburn  10127: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 10128:     }
                   10129: 
                   10130:     sub end_data_table {
1.961     onken    10131: 	&end_data_table_count();
1.389     albertel 10132: 	return '</table>'."\n";;
1.347     albertel 10133:     }
                   10134: 
                   10135:     sub start_data_table_row {
1.974     wenzelju 10136: 	my ($add_class, $id) = @_;
1.610     albertel 10137: 	$row_count[0]++;
                   10138: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   10139: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 10140:         $id = (' id="'.$id.'"') unless ($id eq '');
                   10141:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 10142:     }
1.471     banghart 10143:     
                   10144:     sub continue_data_table_row {
1.974     wenzelju 10145: 	my ($add_class, $id) = @_;
1.610     albertel 10146: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 10147: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   10148:         $id = (' id="'.$id.'"') unless ($id eq '');
                   10149:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 10150:     }
1.347     albertel 10151: 
                   10152:     sub end_data_table_row {
1.389     albertel 10153: 	return '</tr>'."\n";;
1.347     albertel 10154:     }
1.367     www      10155: 
1.421     albertel 10156:     sub start_data_table_empty_row {
1.707     bisitz   10157: #	$row_count[0]++;
1.421     albertel 10158: 	return  '<tr class="LC_empty_row" >'."\n";;
                   10159:     }
                   10160: 
                   10161:     sub end_data_table_empty_row {
                   10162: 	return '</tr>'."\n";;
                   10163:     }
                   10164: 
1.367     www      10165:     sub start_data_table_header_row {
1.389     albertel 10166: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      10167:     }
                   10168: 
                   10169:     sub end_data_table_header_row {
1.389     albertel 10170: 	return '</tr>'."\n";;
1.367     www      10171:     }
1.890     droeschl 10172: 
                   10173:     sub data_table_caption {
                   10174:         my $caption = shift;
                   10175:         return "<caption class=\"LC_caption\">$caption</caption>";
                   10176:     }
1.347     albertel 10177: }
                   10178: 
1.548     albertel 10179: =pod
                   10180: 
                   10181: =item * &inhibit_menu_check($arg)
                   10182: 
                   10183: Checks for a inhibitmenu state and generates output to preserve it
                   10184: 
                   10185: Inputs:         $arg - can be any of
                   10186:                      - undef - in which case the return value is a string 
                   10187:                                to add  into arguments list of a uri
                   10188:                      - 'input' - in which case the return value is a HTML
                   10189:                                  <form> <input> field of type hidden to
                   10190:                                  preserve the value
                   10191:                      - a url - in which case the return value is the url with
                   10192:                                the neccesary cgi args added to preserve the
                   10193:                                inhibitmenu state
                   10194:                      - a ref to a url - no return value, but the string is
                   10195:                                         updated to include the neccessary cgi
                   10196:                                         args to preserve the inhibitmenu state
                   10197: 
                   10198: =cut
                   10199: 
                   10200: sub inhibit_menu_check {
                   10201:     my ($arg) = @_;
                   10202:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   10203:     if ($arg eq 'input') {
                   10204: 	if ($env{'form.inhibitmenu'}) {
                   10205: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   10206: 	} else {
                   10207: 	    return
                   10208: 	}
                   10209:     }
                   10210:     if ($env{'form.inhibitmenu'}) {
                   10211: 	if (ref($arg)) {
                   10212: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   10213: 	} elsif ($arg eq '') {
                   10214: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   10215: 	} else {
                   10216: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   10217: 	}
                   10218:     }
                   10219:     if (!ref($arg)) {
                   10220: 	return $arg;
                   10221:     }
                   10222: }
                   10223: 
1.251     albertel 10224: ###############################################
1.182     matthew  10225: 
                   10226: =pod
                   10227: 
1.549     albertel 10228: =back
                   10229: 
                   10230: =head1 User Information Routines
                   10231: 
                   10232: =over 4
                   10233: 
1.405     albertel 10234: =item * &get_users_function()
1.182     matthew  10235: 
                   10236: Used by &bodytag to determine the current users primary role.
                   10237: Returns either 'student','coordinator','admin', or 'author'.
                   10238: 
                   10239: =cut
                   10240: 
                   10241: ###############################################
                   10242: sub get_users_function {
1.815     tempelho 10243:     my $function = 'norole';
1.818     tempelho 10244:     if ($env{'request.role'}=~/^(st)/) {
                   10245:         $function='student';
                   10246:     }
1.907     raeburn  10247:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  10248:         $function='coordinator';
                   10249:     }
1.258     albertel 10250:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  10251:         $function='admin';
                   10252:     }
1.826     bisitz   10253:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  10254:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  10255:         $function='author';
                   10256:     }
                   10257:     return $function;
1.54      www      10258: }
1.99      www      10259: 
                   10260: ###############################################
                   10261: 
1.233     raeburn  10262: =pod
                   10263: 
1.821     raeburn  10264: =item * &show_course()
                   10265: 
                   10266: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   10267: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   10268: 
                   10269: Inputs:
                   10270: None
                   10271: 
                   10272: Outputs:
                   10273: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   10274: 
                   10275: =cut
                   10276: 
                   10277: ###############################################
                   10278: sub show_course {
                   10279:     my $course = !$env{'user.adv'};
                   10280:     if (!$env{'user.adv'}) {
                   10281:         foreach my $env (keys(%env)) {
                   10282:             next if ($env !~ m/^user\.priv\./);
                   10283:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   10284:                 $course = 0;
                   10285:                 last;
                   10286:             }
                   10287:         }
                   10288:     }
                   10289:     return $course;
                   10290: }
                   10291: 
                   10292: ###############################################
                   10293: 
                   10294: =pod
                   10295: 
1.542     raeburn  10296: =item * &check_user_status()
1.274     raeburn  10297: 
                   10298: Determines current status of supplied role for a
                   10299: specific user. Roles can be active, previous or future.
                   10300: 
                   10301: Inputs: 
                   10302: user's domain, user's username, course's domain,
1.375     raeburn  10303: course's number, optional section ID.
1.274     raeburn  10304: 
                   10305: Outputs:
                   10306: role status: active, previous or future. 
                   10307: 
                   10308: =cut
                   10309: 
                   10310: sub check_user_status {
1.412     raeburn  10311:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  10312:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85  raeburn  10313:     my @uroles = keys(%userinfo);
1.274     raeburn  10314:     my $srchstr;
                   10315:     my $active_chk = 'none';
1.412     raeburn  10316:     my $now = time;
1.274     raeburn  10317:     if (@uroles > 0) {
1.908     raeburn  10318:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  10319:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   10320:         } else {
1.412     raeburn  10321:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   10322:         }
                   10323:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  10324:             my $role_end = 0;
                   10325:             my $role_start = 0;
                   10326:             $active_chk = 'active';
1.412     raeburn  10327:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   10328:                 $role_end = $1;
                   10329:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   10330:                     $role_start = $1;
1.274     raeburn  10331:                 }
                   10332:             }
                   10333:             if ($role_start > 0) {
1.412     raeburn  10334:                 if ($now < $role_start) {
1.274     raeburn  10335:                     $active_chk = 'future';
                   10336:                 }
                   10337:             }
                   10338:             if ($role_end > 0) {
1.412     raeburn  10339:                 if ($now > $role_end) {
1.274     raeburn  10340:                     $active_chk = 'previous';
                   10341:                 }
                   10342:             }
                   10343:         }
                   10344:     }
                   10345:     return $active_chk;
                   10346: }
                   10347: 
                   10348: ###############################################
                   10349: 
                   10350: =pod
                   10351: 
1.405     albertel 10352: =item * &get_sections()
1.233     raeburn  10353: 
                   10354: Determines all the sections for a course including
                   10355: sections with students and sections containing other roles.
1.419     raeburn  10356: Incoming parameters: 
                   10357: 
                   10358: 1. domain
                   10359: 2. course number 
                   10360: 3. reference to array containing roles for which sections should 
                   10361: be gathered (optional).
                   10362: 4. reference to array containing status types for which sections 
                   10363: should be gathered (optional).
                   10364: 
                   10365: If the third argument is undefined, sections are gathered for any role. 
                   10366: If the fourth argument is undefined, sections are gathered for any status.
                   10367: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  10368:  
1.374     raeburn  10369: Returns section hash (keys are section IDs, values are
                   10370: number of users in each section), subject to the
1.419     raeburn  10371: optional roles filter, optional status filter 
1.233     raeburn  10372: 
                   10373: =cut
                   10374: 
                   10375: ###############################################
                   10376: sub get_sections {
1.419     raeburn  10377:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 10378:     if (!defined($cdom) || !defined($cnum)) {
                   10379:         my $cid =  $env{'request.course.id'};
                   10380: 
                   10381: 	return if (!defined($cid));
                   10382: 
                   10383:         $cdom = $env{'course.'.$cid.'.domain'};
                   10384:         $cnum = $env{'course.'.$cid.'.num'};
                   10385:     }
                   10386: 
                   10387:     my %sectioncount;
1.419     raeburn  10388:     my $now = time;
1.240     albertel 10389: 
1.1075.2.33  raeburn  10390:     my $check_students = 1;
                   10391:     my $only_students = 0;
                   10392:     if (ref($possible_roles) eq 'ARRAY') {
                   10393:         if (grep(/^st$/,@{$possible_roles})) {
                   10394:             if (@{$possible_roles} == 1) {
                   10395:                 $only_students = 1;
                   10396:             }
                   10397:         } else {
                   10398:             $check_students = 0;
                   10399:         }
                   10400:     }
                   10401: 
                   10402:     if ($check_students) {
1.276     albertel 10403: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 10404: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   10405: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  10406:         my $start_index = &Apache::loncoursedata::CL_START();
                   10407:         my $end_index = &Apache::loncoursedata::CL_END();
                   10408:         my $status;
1.366     albertel 10409: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  10410: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   10411: 				                     $data->[$status_index],
                   10412:                                                      $data->[$start_index],
                   10413:                                                      $data->[$end_index]);
                   10414:             if ($stu_status eq 'Active') {
                   10415:                 $status = 'active';
                   10416:             } elsif ($end < $now) {
                   10417:                 $status = 'previous';
                   10418:             } elsif ($start > $now) {
                   10419:                 $status = 'future';
                   10420:             } 
                   10421: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   10422:                 if ((!defined($possible_status)) || (($status ne '') && 
                   10423:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   10424: 		    $sectioncount{$section}++;
                   10425:                 }
1.240     albertel 10426: 	    }
                   10427: 	}
                   10428:     }
1.1075.2.33  raeburn  10429:     if ($only_students) {
                   10430:         return %sectioncount;
                   10431:     }
1.240     albertel 10432:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   10433:     foreach my $user (sort(keys(%courseroles))) {
                   10434: 	if ($user !~ /^(\w{2})/) { next; }
                   10435: 	my ($role) = ($user =~ /^(\w{2})/);
                   10436: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  10437: 	my ($section,$status);
1.240     albertel 10438: 	if ($role eq 'cr' &&
                   10439: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   10440: 	    $section=$1;
                   10441: 	}
                   10442: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   10443: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  10444:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   10445:         if ($end == -1 && $start == -1) {
                   10446:             next; #deleted role
                   10447:         }
                   10448:         if (!defined($possible_status)) { 
                   10449:             $sectioncount{$section}++;
                   10450:         } else {
                   10451:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   10452:                 $status = 'active';
                   10453:             } elsif ($end < $now) {
                   10454:                 $status = 'future';
                   10455:             } elsif ($start > $now) {
                   10456:                 $status = 'previous';
                   10457:             }
                   10458:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   10459:                 $sectioncount{$section}++;
                   10460:             }
                   10461:         }
1.233     raeburn  10462:     }
1.366     albertel 10463:     return %sectioncount;
1.233     raeburn  10464: }
                   10465: 
1.274     raeburn  10466: ###############################################
1.294     raeburn  10467: 
                   10468: =pod
1.405     albertel 10469: 
                   10470: =item * &get_course_users()
                   10471: 
1.275     raeburn  10472: Retrieves usernames:domains for users in the specified course
                   10473: with specific role(s), and access status. 
                   10474: 
                   10475: Incoming parameters:
1.277     albertel 10476: 1. course domain
                   10477: 2. course number
                   10478: 3. access status: users must have - either active, 
1.275     raeburn  10479: previous, future, or all.
1.277     albertel 10480: 4. reference to array of permissible roles
1.288     raeburn  10481: 5. reference to array of section restrictions (optional)
                   10482: 6. reference to results object (hash of hashes).
                   10483: 7. reference to optional userdata hash
1.609     raeburn  10484: 8. reference to optional statushash
1.630     raeburn  10485: 9. flag if privileged users (except those set to unhide in
                   10486:    course settings) should be excluded    
1.609     raeburn  10487: Keys of top level results hash are roles.
1.275     raeburn  10488: Keys of inner hashes are username:domain, with 
                   10489: values set to access type.
1.288     raeburn  10490: Optional userdata hash returns an array with arguments in the 
                   10491: same order as loncoursedata::get_classlist() for student data.
                   10492: 
1.609     raeburn  10493: Optional statushash returns
                   10494: 
1.288     raeburn  10495: Entries for end, start, section and status are blank because
                   10496: of the possibility of multiple values for non-student roles.
                   10497: 
1.275     raeburn  10498: =cut
1.405     albertel 10499: 
1.275     raeburn  10500: ###############################################
1.405     albertel 10501: 
1.275     raeburn  10502: sub get_course_users {
1.630     raeburn  10503:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  10504:     my %idx = ();
1.419     raeburn  10505:     my %seclists;
1.288     raeburn  10506: 
                   10507:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   10508:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   10509:     $idx{end} = &Apache::loncoursedata::CL_END();
                   10510:     $idx{start} = &Apache::loncoursedata::CL_START();
                   10511:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   10512:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   10513:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   10514:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   10515: 
1.290     albertel 10516:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 10517:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  10518:         my $now = time;
1.277     albertel 10519:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  10520:             my $match = 0;
1.412     raeburn  10521:             my $secmatch = 0;
1.419     raeburn  10522:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  10523:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  10524:             if ($section eq '') {
                   10525:                 $section = 'none';
                   10526:             }
1.291     albertel 10527:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 10528:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  10529:                     $secmatch = 1;
                   10530:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 10531:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  10532:                         $secmatch = 1;
                   10533:                     }
                   10534:                 } else {  
1.419     raeburn  10535: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  10536: 		        $secmatch = 1;
                   10537:                     }
1.290     albertel 10538: 		}
1.412     raeburn  10539:                 if (!$secmatch) {
                   10540:                     next;
                   10541:                 }
1.419     raeburn  10542:             }
1.275     raeburn  10543:             if (defined($$types{'active'})) {
1.288     raeburn  10544:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  10545:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  10546:                     $match = 1;
1.275     raeburn  10547:                 }
                   10548:             }
                   10549:             if (defined($$types{'previous'})) {
1.609     raeburn  10550:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  10551:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  10552:                     $match = 1;
1.275     raeburn  10553:                 }
                   10554:             }
                   10555:             if (defined($$types{'future'})) {
1.609     raeburn  10556:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  10557:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  10558:                     $match = 1;
1.275     raeburn  10559:                 }
                   10560:             }
1.609     raeburn  10561:             if ($match) {
                   10562:                 push(@{$seclists{$student}},$section);
                   10563:                 if (ref($userdata) eq 'HASH') {
                   10564:                     $$userdata{$student} = $$classlist{$student};
                   10565:                 }
                   10566:                 if (ref($statushash) eq 'HASH') {
                   10567:                     $statushash->{$student}{'st'}{$section} = $status;
                   10568:                 }
1.288     raeburn  10569:             }
1.275     raeburn  10570:         }
                   10571:     }
1.412     raeburn  10572:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  10573:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   10574:         my $now = time;
1.609     raeburn  10575:         my %displaystatus = ( previous => 'Expired',
                   10576:                               active   => 'Active',
                   10577:                               future   => 'Future',
                   10578:                             );
1.1075.2.36  raeburn  10579:         my (%nothide,@possdoms);
1.630     raeburn  10580:         if ($hidepriv) {
                   10581:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   10582:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   10583:                 if ($user !~ /:/) {
                   10584:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   10585:                 } else {
                   10586:                     $nothide{$user} = 1;
                   10587:                 }
                   10588:             }
1.1075.2.36  raeburn  10589:             my @possdoms = ($cdom);
                   10590:             if ($coursehash{'checkforpriv'}) {
                   10591:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   10592:             }
1.630     raeburn  10593:         }
1.439     raeburn  10594:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  10595:             my $match = 0;
1.412     raeburn  10596:             my $secmatch = 0;
1.439     raeburn  10597:             my $status;
1.412     raeburn  10598:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  10599:             $user =~ s/:$//;
1.439     raeburn  10600:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   10601:             if ($end == -1 || $start == -1) {
                   10602:                 next;
                   10603:             }
                   10604:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   10605:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  10606:                 my ($uname,$udom) = split(/:/,$user);
                   10607:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 10608:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  10609:                         $secmatch = 1;
                   10610:                     } elsif ($usec eq '') {
1.420     albertel 10611:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  10612:                             $secmatch = 1;
                   10613:                         }
                   10614:                     } else {
                   10615:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   10616:                             $secmatch = 1;
                   10617:                         }
                   10618:                     }
                   10619:                     if (!$secmatch) {
                   10620:                         next;
                   10621:                     }
1.288     raeburn  10622:                 }
1.419     raeburn  10623:                 if ($usec eq '') {
                   10624:                     $usec = 'none';
                   10625:                 }
1.275     raeburn  10626:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  10627:                     if ($hidepriv) {
1.1075.2.36  raeburn  10628:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  10629:                             (!$nothide{$uname.':'.$udom})) {
                   10630:                             next;
                   10631:                         }
                   10632:                     }
1.503     raeburn  10633:                     if ($end > 0 && $end < $now) {
1.439     raeburn  10634:                         $status = 'previous';
                   10635:                     } elsif ($start > $now) {
                   10636:                         $status = 'future';
                   10637:                     } else {
                   10638:                         $status = 'active';
                   10639:                     }
1.277     albertel 10640:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  10641:                         if ($status eq $type) {
1.420     albertel 10642:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  10643:                                 push(@{$$users{$role}{$user}},$type);
                   10644:                             }
1.288     raeburn  10645:                             $match = 1;
                   10646:                         }
                   10647:                     }
1.419     raeburn  10648:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   10649:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   10650: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   10651:                         }
1.420     albertel 10652:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  10653:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   10654:                         }
1.609     raeburn  10655:                         if (ref($statushash) eq 'HASH') {
                   10656:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   10657:                         }
1.275     raeburn  10658:                     }
                   10659:                 }
                   10660:             }
                   10661:         }
1.290     albertel 10662:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  10663:             if ((defined($cdom)) && (defined($cnum))) {
                   10664:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   10665:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   10666:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  10667:                     next if ($owner eq '');
                   10668:                     my ($ownername,$ownerdom);
                   10669:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   10670:                         $ownername = $1;
                   10671:                         $ownerdom = $2;
                   10672:                     } else {
                   10673:                         $ownername = $owner;
                   10674:                         $ownerdom = $cdom;
                   10675:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  10676:                     }
                   10677:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 10678:                     if (defined($userdata) && 
1.609     raeburn  10679: 			!exists($$userdata{$owner})) {
                   10680: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   10681:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   10682:                             push(@{$seclists{$owner}},'none');
                   10683:                         }
                   10684:                         if (ref($statushash) eq 'HASH') {
                   10685:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  10686:                         }
1.290     albertel 10687: 		    }
1.279     raeburn  10688:                 }
                   10689:             }
                   10690:         }
1.419     raeburn  10691:         foreach my $user (keys(%seclists)) {
                   10692:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   10693:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   10694:         }
1.275     raeburn  10695:     }
                   10696:     return;
                   10697: }
                   10698: 
1.288     raeburn  10699: sub get_user_info {
                   10700:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 10701:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   10702: 	&plainname($uname,$udom,'lastname');
1.291     albertel 10703:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  10704:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  10705:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   10706:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  10707:     return;
                   10708: }
1.275     raeburn  10709: 
1.472     raeburn  10710: ###############################################
                   10711: 
                   10712: =pod
                   10713: 
                   10714: =item * &get_user_quota()
                   10715: 
1.1075.2.41  raeburn  10716: Retrieves quota assigned for storage of user files.
                   10717: Default is to report quota for portfolio files.
1.472     raeburn  10718: 
                   10719: Incoming parameters:
                   10720: 1. user's username
                   10721: 2. user's domain
1.1075.2.41  raeburn  10722: 3. quota name - portfolio, author, or course
                   10723:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  10724: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  10725:    course
1.472     raeburn  10726: 
                   10727: Returns:
1.1075.2.58  raeburn  10728: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  10729: 2. (Optional) Type of setting: custom or default
                   10730:    (individually assigned or default for user's 
                   10731:    institutional status).
                   10732: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   10733:    or student - types as defined in localenroll::inst_usertypes 
                   10734:    for user's domain, which determines default quota for user.
                   10735: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  10736: 
                   10737: If a value has been stored in the user's environment, 
1.536     raeburn  10738: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  10739: defined for the user's institutional status(es) in the domain.
1.472     raeburn  10740: 
                   10741: =cut
                   10742: 
                   10743: ###############################################
                   10744: 
                   10745: 
                   10746: sub get_user_quota {
1.1075.2.42  raeburn  10747:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  10748:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  10749:     if (!defined($udom)) {
                   10750:         $udom = $env{'user.domain'};
                   10751:     }
                   10752:     if (!defined($uname)) {
                   10753:         $uname = $env{'user.name'};
                   10754:     }
                   10755:     if (($udom eq '' || $uname eq '') ||
                   10756:         ($udom eq 'public') && ($uname eq 'public')) {
                   10757:         $quota = 0;
1.536     raeburn  10758:         $quotatype = 'default';
                   10759:         $defquota = 0; 
1.472     raeburn  10760:     } else {
1.536     raeburn  10761:         my $inststatus;
1.1075.2.41  raeburn  10762:         if ($quotaname eq 'course') {
                   10763:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   10764:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   10765:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   10766:             } else {
                   10767:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   10768:                 $quota = $cenv{'internal.uploadquota'};
                   10769:             }
1.536     raeburn  10770:         } else {
1.1075.2.41  raeburn  10771:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   10772:                 if ($quotaname eq 'author') {
                   10773:                     $quota = $env{'environment.authorquota'};
                   10774:                 } else {
                   10775:                     $quota = $env{'environment.portfolioquota'};
                   10776:                 }
                   10777:                 $inststatus = $env{'environment.inststatus'};
                   10778:             } else {
                   10779:                 my %userenv = 
                   10780:                     &Apache::lonnet::get('environment',['portfolioquota',
                   10781:                                          'authorquota','inststatus'],$udom,$uname);
                   10782:                 my ($tmp) = keys(%userenv);
                   10783:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   10784:                     if ($quotaname eq 'author') {
                   10785:                         $quota = $userenv{'authorquota'};
                   10786:                     } else {
                   10787:                         $quota = $userenv{'portfolioquota'};
                   10788:                     }
                   10789:                     $inststatus = $userenv{'inststatus'};
                   10790:                 } else {
                   10791:                     undef(%userenv);
                   10792:                 }
                   10793:             }
                   10794:         }
                   10795:         if ($quota eq '' || wantarray) {
                   10796:             if ($quotaname eq 'course') {
                   10797:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  10798:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   10799:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  10800:                     $defquota = $domdefs{$crstype.'quota'};
                   10801:                 }
                   10802:                 if ($defquota eq '') {
                   10803:                     $defquota = 500;
                   10804:                 }
1.1075.2.41  raeburn  10805:             } else {
                   10806:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   10807:             }
                   10808:             if ($quota eq '') {
                   10809:                 $quota = $defquota;
                   10810:                 $quotatype = 'default';
                   10811:             } else {
                   10812:                 $quotatype = 'custom';
                   10813:             }
1.472     raeburn  10814:         }
                   10815:     }
1.536     raeburn  10816:     if (wantarray) {
                   10817:         return ($quota,$quotatype,$settingstatus,$defquota);
                   10818:     } else {
                   10819:         return $quota;
                   10820:     }
1.472     raeburn  10821: }
                   10822: 
                   10823: ###############################################
                   10824: 
                   10825: =pod
                   10826: 
                   10827: =item * &default_quota()
                   10828: 
1.536     raeburn  10829: Retrieves default quota assigned for storage of user portfolio files,
                   10830: given an (optional) user's institutional status.
1.472     raeburn  10831: 
                   10832: Incoming parameters:
1.1075.2.42  raeburn  10833: 
1.472     raeburn  10834: 1. domain
1.536     raeburn  10835: 2. (Optional) institutional status(es).  This is a : separated list of 
                   10836:    status types (e.g., faculty, staff, student etc.)
                   10837:    which apply to the user for whom the default is being retrieved.
                   10838:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  10839:    default quota will be returned.
                   10840: 3.  quota name - portfolio, author, or course
                   10841:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  10842: 
                   10843: Returns:
1.1075.2.42  raeburn  10844: 
1.1075.2.58  raeburn  10845: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  10846: 2. (Optional) institutional type which determined the value of the
                   10847:    default quota.
1.472     raeburn  10848: 
                   10849: If a value has been stored in the domain's configuration db,
                   10850: it will return that, otherwise it returns 20 (for backwards 
                   10851: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  10852: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  10853: 
1.536     raeburn  10854: If the user's status includes multiple types (e.g., staff and student),
                   10855: the largest default quota which applies to the user determines the
                   10856: default quota returned.
                   10857: 
1.472     raeburn  10858: =cut
                   10859: 
                   10860: ###############################################
                   10861: 
                   10862: 
                   10863: sub default_quota {
1.1075.2.41  raeburn  10864:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  10865:     my ($defquota,$settingstatus);
                   10866:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  10867:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  10868:     my $key = 'defaultquota';
                   10869:     if ($quotaname eq 'author') {
                   10870:         $key = 'authorquota';
                   10871:     }
1.622     raeburn  10872:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  10873:         if ($inststatus ne '') {
1.765     raeburn  10874:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  10875:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  10876:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   10877:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  10878:                         if ($defquota eq '') {
1.1075.2.41  raeburn  10879:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  10880:                             $settingstatus = $item;
1.1075.2.41  raeburn  10881:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   10882:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  10883:                             $settingstatus = $item;
                   10884:                         }
                   10885:                     }
1.1075.2.41  raeburn  10886:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  10887:                     if ($quotahash{'quotas'}{$item} ne '') {
                   10888:                         if ($defquota eq '') {
                   10889:                             $defquota = $quotahash{'quotas'}{$item};
                   10890:                             $settingstatus = $item;
                   10891:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   10892:                             $defquota = $quotahash{'quotas'}{$item};
                   10893:                             $settingstatus = $item;
                   10894:                         }
1.536     raeburn  10895:                     }
                   10896:                 }
                   10897:             }
                   10898:         }
                   10899:         if ($defquota eq '') {
1.1075.2.41  raeburn  10900:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   10901:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   10902:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  10903:                 $defquota = $quotahash{'quotas'}{'default'};
                   10904:             }
1.536     raeburn  10905:             $settingstatus = 'default';
1.1075.2.42  raeburn  10906:             if ($defquota eq '') {
                   10907:                 if ($quotaname eq 'author') {
                   10908:                     $defquota = 500;
                   10909:                 }
                   10910:             }
1.536     raeburn  10911:         }
                   10912:     } else {
                   10913:         $settingstatus = 'default';
1.1075.2.41  raeburn  10914:         if ($quotaname eq 'author') {
                   10915:             $defquota = 500;
                   10916:         } else {
                   10917:             $defquota = 20;
                   10918:         }
1.536     raeburn  10919:     }
                   10920:     if (wantarray) {
                   10921:         return ($defquota,$settingstatus);
1.472     raeburn  10922:     } else {
1.536     raeburn  10923:         return $defquota;
1.472     raeburn  10924:     }
                   10925: }
                   10926: 
1.1075.2.41  raeburn  10927: ###############################################
                   10928: 
                   10929: =pod
                   10930: 
1.1075.2.42  raeburn  10931: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  10932: 
                   10933: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  10934: of existing file within authoring space will cause quota for the authoring
                   10935: space to be exceeded.
                   10936: 
                   10937: Same, if upload of a file directly to a course/community via Course Editor
                   10938: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  10939: 
1.1075.2.61  raeburn  10940: Inputs: 7 
1.1075.2.42  raeburn  10941: 1. username or coursenum
1.1075.2.41  raeburn  10942: 2. domain
1.1075.2.42  raeburn  10943: 3. context ('author' or 'course')
1.1075.2.41  raeburn  10944: 4. filename of file for which action is being requested
                   10945: 5. filesize (kB) of file
                   10946: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  10947: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  10948: 
                   10949: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   10950:          otherwise return null.
                   10951: 
1.1075.2.42  raeburn  10952: =back
                   10953: 
1.1075.2.41  raeburn  10954: =cut
                   10955: 
1.1075.2.42  raeburn  10956: sub excess_filesize_warning {
1.1075.2.59  raeburn  10957:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  10958:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  10959:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  10960:     if ($context eq 'author') {
                   10961:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   10962:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   10963:     } else {
                   10964:         foreach my $subdir ('docs','supplemental') {
                   10965:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   10966:         }
                   10967:     }
1.1075.2.41  raeburn  10968:     $disk_quota = int($disk_quota * 1000);
                   10969:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  10970:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  10971:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  10972:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   10973:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  10974:                             $disk_quota,$current_disk_usage).
                   10975:                '</p>';
                   10976:     }
                   10977:     return;
                   10978: }
                   10979: 
                   10980: ###############################################
                   10981: 
                   10982: 
1.384     raeburn  10983: sub get_secgrprole_info {
                   10984:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   10985:     my %sections_count = &get_sections($cdom,$cnum);
                   10986:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   10987:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   10988:     my @groups = sort(keys(%curr_groups));
                   10989:     my $allroles = [];
                   10990:     my $rolehash;
                   10991:     my $accesshash = {
                   10992:                      active => 'Currently has access',
                   10993:                      future => 'Will have future access',
                   10994:                      previous => 'Previously had access',
                   10995:                   };
                   10996:     if ($needroles) {
                   10997:         $rolehash = {'all' => 'all'};
1.385     albertel 10998:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   10999: 	if (&Apache::lonnet::error(%user_roles)) {
                   11000: 	    undef(%user_roles);
                   11001: 	}
                   11002:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  11003:             my ($role)=split(/\:/,$item,2);
                   11004:             if ($role eq 'cr') { next; }
                   11005:             if ($role =~ /^cr/) {
                   11006:                 $$rolehash{$role} = (split('/',$role))[3];
                   11007:             } else {
                   11008:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   11009:             }
                   11010:         }
                   11011:         foreach my $key (sort(keys(%{$rolehash}))) {
                   11012:             push(@{$allroles},$key);
                   11013:         }
                   11014:         push (@{$allroles},'st');
                   11015:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   11016:     }
                   11017:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   11018: }
                   11019: 
1.555     raeburn  11020: sub user_picker {
1.1075.2.127  raeburn  11021:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555     raeburn  11022:     my $currdom = $dom;
1.1075.2.114  raeburn  11023:     my @alldoms = &Apache::lonnet::all_domains();
                   11024:     if (@alldoms == 1) {
                   11025:         my %domsrch = &Apache::lonnet::get_dom('configuration',
                   11026:                                                ['directorysrch'],$alldoms[0]);
                   11027:         my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
                   11028:         my $showdom = $domdesc;
                   11029:         if ($showdom eq '') {
                   11030:             $showdom = $dom;
                   11031:         }
                   11032:         if (ref($domsrch{'directorysrch'}) eq 'HASH') {
                   11033:             if ((!$domsrch{'directorysrch'}{'available'}) &&
                   11034:                 ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   11035:                 return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
                   11036:             }
                   11037:         }
                   11038:     }
1.555     raeburn  11039:     my %curr_selected = (
                   11040:                         srchin => 'dom',
1.580     raeburn  11041:                         srchby => 'lastname',
1.555     raeburn  11042:                       );
                   11043:     my $srchterm;
1.625     raeburn  11044:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  11045:         if ($srch->{'srchby'} ne '') {
                   11046:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   11047:         }
                   11048:         if ($srch->{'srchin'} ne '') {
                   11049:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   11050:         }
                   11051:         if ($srch->{'srchtype'} ne '') {
                   11052:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   11053:         }
                   11054:         if ($srch->{'srchdomain'} ne '') {
                   11055:             $currdom = $srch->{'srchdomain'};
                   11056:         }
                   11057:         $srchterm = $srch->{'srchterm'};
                   11058:     }
1.1075.2.98  raeburn  11059:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  11060:                     'usr'       => 'Search criteria',
1.563     raeburn  11061:                     'doma'      => 'Domain/institution to search',
1.558     albertel 11062:                     'uname'     => 'username',
                   11063:                     'lastname'  => 'last name',
1.555     raeburn  11064:                     'lastfirst' => 'last name, first name',
1.558     albertel 11065:                     'crs'       => 'in this course',
1.576     raeburn  11066:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 11067:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  11068:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 11069:                     'exact'     => 'is',
                   11070:                     'contains'  => 'contains',
1.569     raeburn  11071:                     'begins'    => 'begins with',
1.1075.2.98  raeburn  11072:                                        );
                   11073:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  11074:                     'youm'      => "You must include some text to search for.",
                   11075:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   11076:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   11077:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   11078:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   11079:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   11080:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   11081:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  11082:                                        );
1.1075.2.98  raeburn  11083:     &html_escape(\%html_lt);
                   11084:     &js_escape(\%js_lt);
1.1075.2.115  raeburn  11085:     my $domform;
1.1075.2.126  raeburn  11086:     my $allow_blank = 1;
1.1075.2.115  raeburn  11087:     if ($fixeddom) {
1.1075.2.126  raeburn  11088:         $allow_blank = 0;
                   11089:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1075.2.115  raeburn  11090:     } else {
1.1075.2.126  raeburn  11091:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
1.1075.2.115  raeburn  11092:     }
1.563     raeburn  11093:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  11094: 
                   11095:     my @srchins = ('crs','dom','alc','instd');
                   11096: 
                   11097:     foreach my $option (@srchins) {
                   11098:         # FIXME 'alc' option unavailable until 
                   11099:         #       loncreateuser::print_user_query_page()
                   11100:         #       has been completed.
                   11101:         next if ($option eq 'alc');
1.880     raeburn  11102:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  11103:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.1075.2.127  raeburn  11104:         next if (($option eq 'instd') && ($noinstd));
1.563     raeburn  11105:         if ($curr_selected{'srchin'} eq $option) {
                   11106:             $srchinsel .= ' 
1.1075.2.98  raeburn  11107:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  11108:         } else {
                   11109:             $srchinsel .= '
1.1075.2.98  raeburn  11110:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  11111:         }
1.555     raeburn  11112:     }
1.563     raeburn  11113:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  11114: 
                   11115:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  11116:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  11117:         if ($curr_selected{'srchby'} eq $option) {
                   11118:             $srchbysel .= '
1.1075.2.98  raeburn  11119:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  11120:         } else {
                   11121:             $srchbysel .= '
1.1075.2.98  raeburn  11122:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  11123:          }
                   11124:     }
                   11125:     $srchbysel .= "\n  </select>\n";
                   11126: 
                   11127:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  11128:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  11129:         if ($curr_selected{'srchtype'} eq $option) {
                   11130:             $srchtypesel .= '
1.1075.2.98  raeburn  11131:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  11132:         } else {
                   11133:             $srchtypesel .= '
1.1075.2.98  raeburn  11134:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  11135:         }
                   11136:     }
                   11137:     $srchtypesel .= "\n  </select>\n";
                   11138: 
1.558     albertel 11139:     my ($newuserscript,$new_user_create);
1.994     raeburn  11140:     my $context_dom = $env{'request.role.domain'};
                   11141:     if ($context eq 'requestcrs') {
                   11142:         if ($env{'form.coursedom'} ne '') { 
                   11143:             $context_dom = $env{'form.coursedom'};
                   11144:         }
                   11145:     }
1.556     raeburn  11146:     if ($forcenewuser) {
1.576     raeburn  11147:         if (ref($srch) eq 'HASH') {
1.994     raeburn  11148:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  11149:                 if ($cancreate) {
                   11150:                     $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>';
                   11151:                 } else {
1.799     bisitz   11152:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  11153:                     my %usertypetext = (
                   11154:                         official   => 'institutional',
                   11155:                         unofficial => 'non-institutional',
                   11156:                     );
1.799     bisitz   11157:                     $new_user_create = '<p class="LC_warning">'
                   11158:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   11159:                                       .' '
                   11160:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   11161:                                           ,'<a href="'.$helplink.'">','</a>')
                   11162:                                       .'</p><br />';
1.627     raeburn  11163:                 }
1.576     raeburn  11164:             }
                   11165:         }
                   11166: 
1.556     raeburn  11167:         $newuserscript = <<"ENDSCRIPT";
                   11168: 
1.570     raeburn  11169: function setSearch(createnew,callingForm) {
1.556     raeburn  11170:     if (createnew == 1) {
1.570     raeburn  11171:         for (var i=0; i<callingForm.srchby.length; i++) {
                   11172:             if (callingForm.srchby.options[i].value == 'uname') {
                   11173:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  11174:             }
                   11175:         }
1.570     raeburn  11176:         for (var i=0; i<callingForm.srchin.length; i++) {
                   11177:             if ( callingForm.srchin.options[i].value == 'dom') {
                   11178: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  11179:             }
                   11180:         }
1.570     raeburn  11181:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   11182:             if (callingForm.srchtype.options[i].value == 'exact') {
                   11183:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  11184:             }
                   11185:         }
1.570     raeburn  11186:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  11187:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  11188:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  11189:             }
                   11190:         }
                   11191:     }
                   11192: }
                   11193: ENDSCRIPT
1.558     albertel 11194: 
1.556     raeburn  11195:     }
                   11196: 
1.555     raeburn  11197:     my $output = <<"END_BLOCK";
1.556     raeburn  11198: <script type="text/javascript">
1.824     bisitz   11199: // <![CDATA[
1.570     raeburn  11200: function validateEntry(callingForm) {
1.558     albertel 11201: 
1.556     raeburn  11202:     var checkok = 1;
1.558     albertel 11203:     var srchin;
1.570     raeburn  11204:     for (var i=0; i<callingForm.srchin.length; i++) {
                   11205: 	if ( callingForm.srchin[i].checked ) {
                   11206: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 11207: 	}
                   11208:     }
                   11209: 
1.570     raeburn  11210:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   11211:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   11212:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   11213:     var srchterm =  callingForm.srchterm.value;
                   11214:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  11215:     var msg = "";
                   11216: 
                   11217:     if (srchterm == "") {
                   11218:         checkok = 0;
1.1075.2.98  raeburn  11219:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  11220:     }
                   11221: 
1.569     raeburn  11222:     if (srchtype== 'begins') {
                   11223:         if (srchterm.length < 2) {
                   11224:             checkok = 0;
1.1075.2.98  raeburn  11225:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  11226:         }
                   11227:     }
                   11228: 
1.556     raeburn  11229:     if (srchtype== 'contains') {
                   11230:         if (srchterm.length < 3) {
                   11231:             checkok = 0;
1.1075.2.98  raeburn  11232:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  11233:         }
                   11234:     }
                   11235:     if (srchin == 'instd') {
                   11236:         if (srchdomain == '') {
                   11237:             checkok = 0;
1.1075.2.98  raeburn  11238:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  11239:         }
                   11240:     }
                   11241:     if (srchin == 'dom') {
                   11242:         if (srchdomain == '') {
                   11243:             checkok = 0;
1.1075.2.98  raeburn  11244:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  11245:         }
                   11246:     }
                   11247:     if (srchby == 'lastfirst') {
                   11248:         if (srchterm.indexOf(",") == -1) {
                   11249:             checkok = 0;
1.1075.2.98  raeburn  11250:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  11251:         }
                   11252:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   11253:             checkok = 0;
1.1075.2.98  raeburn  11254:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  11255:         }
                   11256:     }
                   11257:     if (checkok == 0) {
1.1075.2.98  raeburn  11258:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  11259:         return;
                   11260:     }
                   11261:     if (checkok == 1) {
1.570     raeburn  11262:         callingForm.submit();
1.556     raeburn  11263:     }
                   11264: }
                   11265: 
                   11266: $newuserscript
                   11267: 
1.824     bisitz   11268: // ]]>
1.556     raeburn  11269: </script>
1.558     albertel 11270: 
                   11271: $new_user_create
                   11272: 
1.555     raeburn  11273: END_BLOCK
1.558     albertel 11274: 
1.876     raeburn  11275:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98  raeburn  11276:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  11277:                $domform.
                   11278:                &Apache::lonhtmlcommon::row_closure().
1.1075.2.98  raeburn  11279:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  11280:                $srchbysel.
                   11281:                $srchtypesel. 
                   11282:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   11283:                $srchinsel.
                   11284:                &Apache::lonhtmlcommon::row_closure(1). 
                   11285:                &Apache::lonhtmlcommon::end_pick_box().
                   11286:                '<br />';
1.1075.2.114  raeburn  11287:     return ($output,1);
1.555     raeburn  11288: }
                   11289: 
1.612     raeburn  11290: sub user_rule_check {
1.615     raeburn  11291:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99  raeburn  11292:     my ($response,%inst_response);
1.612     raeburn  11293:     if (ref($usershash) eq 'HASH') {
1.1075.2.99  raeburn  11294:         if (keys(%{$usershash}) > 1) {
                   11295:             my (%by_username,%by_id,%userdoms);
                   11296:             my $checkid;
1.612     raeburn  11297:             if (ref($checks) eq 'HASH') {
1.1075.2.99  raeburn  11298:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   11299:                     $checkid = 1;
                   11300:                 }
                   11301:             }
                   11302:             foreach my $user (keys(%{$usershash})) {
                   11303:                 my ($uname,$udom) = split(/:/,$user);
                   11304:                 if ($checkid) {
                   11305:                     if (ref($usershash->{$user}) eq 'HASH') {
                   11306:                         if ($usershash->{$user}->{'id'} ne '') {
                   11307:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
                   11308:                             $userdoms{$udom} = 1;
                   11309:                             if (ref($inst_results) eq 'HASH') {
                   11310:                                 $inst_results->{$uname.':'.$udom} = {};
                   11311:                             }
                   11312:                         }
                   11313:                     }
                   11314:                 } else {
                   11315:                     $by_username{$udom}{$uname} = 1;
                   11316:                     $userdoms{$udom} = 1;
                   11317:                     if (ref($inst_results) eq 'HASH') {
                   11318:                         $inst_results->{$uname.':'.$udom} = {};
                   11319:                     }
                   11320:                 }
                   11321:             }
                   11322:             foreach my $udom (keys(%userdoms)) {
                   11323:                 if (!$got_rules->{$udom}) {
                   11324:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   11325:                                                              ['usercreation'],$udom);
                   11326:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   11327:                         foreach my $item ('username','id') {
                   11328:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   11329:                                 $$curr_rules{$udom}{$item} =
                   11330:                                     $domconfig{'usercreation'}{$item.'_rule'};
                   11331:                             }
                   11332:                         }
                   11333:                     }
                   11334:                     $got_rules->{$udom} = 1;
                   11335:                 }
                   11336:             }
                   11337:             if ($checkid) {
                   11338:                 foreach my $udom (keys(%by_id)) {
                   11339:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   11340:                     if ($outcome eq 'ok') {
                   11341:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   11342:                             my $uname = $by_id{$udom}{$id};
                   11343:                             $inst_response{$uname.':'.$udom} = $outcome;
                   11344:                         }
                   11345:                         if (ref($results) eq 'HASH') {
                   11346:                             foreach my $uname (keys(%{$results})) {
                   11347:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   11348:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   11349:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   11350:                                 }
                   11351:                             }
                   11352:                         }
                   11353:                     }
1.612     raeburn  11354:                 }
1.615     raeburn  11355:             } else {
1.1075.2.99  raeburn  11356:                 foreach my $udom (keys(%by_username)) {
                   11357:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   11358:                     if ($outcome eq 'ok') {
                   11359:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   11360:                             $inst_response{$uname.':'.$udom} = $outcome;
                   11361:                         }
                   11362:                         if (ref($results) eq 'HASH') {
                   11363:                             foreach my $uname (keys(%{$results})) {
                   11364:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   11365:                             }
                   11366:                         }
                   11367:                     }
                   11368:                 }
1.612     raeburn  11369:             }
1.1075.2.99  raeburn  11370:         } elsif (keys(%{$usershash}) == 1) {
                   11371:             my $user = (keys(%{$usershash}))[0];
                   11372:             my ($uname,$udom) = split(/:/,$user);
                   11373:             if (($udom ne '') && ($uname ne '')) {
                   11374:                 if (ref($usershash->{$user}) eq 'HASH') {
                   11375:                     if (ref($checks) eq 'HASH') {
                   11376:                         if (defined($checks->{'username'})) {
                   11377:                             ($inst_response{$user},%{$inst_results->{$user}}) =
                   11378:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   11379:                         } elsif (defined($checks->{'id'})) {
                   11380:                             if ($usershash->{$user}->{'id'} ne '') {
                   11381:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   11382:                                     &Apache::lonnet::get_instuser($udom,undef,
                   11383:                                                                   $usershash->{$user}->{'id'});
                   11384:                             } else {
                   11385:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   11386:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   11387:                             }
                   11388:                         }
                   11389:                     } else {
                   11390:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   11391:                             &Apache::lonnet::get_instuser($udom,$uname);
                   11392:                        return;
                   11393:                     }
                   11394:                     if (!$got_rules->{$udom}) {
                   11395:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   11396:                                                                  ['usercreation'],$udom);
                   11397:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   11398:                             foreach my $item ('username','id') {
                   11399:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   11400:                                    $$curr_rules{$udom}{$item} =
                   11401:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   11402:                                 }
                   11403:                             }
1.585     raeburn  11404:                         }
1.1075.2.99  raeburn  11405:                         $got_rules->{$udom} = 1;
1.585     raeburn  11406:                     }
                   11407:                 }
1.1075.2.99  raeburn  11408:             } else {
                   11409:                 return;
                   11410:             }
                   11411:         } else {
                   11412:             return;
                   11413:         }
                   11414:         foreach my $user (keys(%{$usershash})) {
                   11415:             my ($uname,$udom) = split(/:/,$user);
                   11416:             next if (($udom eq '') || ($uname eq ''));
                   11417:             my $id;
                   11418:             if (ref($inst_results) eq 'HASH') {
                   11419:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   11420:                     $id = $inst_results->{$user}->{'id'};
                   11421:                 }
                   11422:             }
                   11423:             if ($id eq '') {
                   11424:                 if (ref($usershash->{$user})) {
                   11425:                     $id = $usershash->{$user}->{'id'};
                   11426:                 }
1.585     raeburn  11427:             }
1.612     raeburn  11428:             foreach my $item (keys(%{$checks})) {
                   11429:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   11430:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   11431:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99  raeburn  11432:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   11433:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  11434:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   11435:                                 if ($rule_check{$rule}) {
                   11436:                                     $$rulematch{$user}{$item} = $rule;
1.1075.2.99  raeburn  11437:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  11438:                                         if (ref($inst_results) eq 'HASH') {
                   11439:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   11440:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   11441:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99  raeburn  11442:                                                 } elsif ($item eq 'id') {
                   11443:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   11444:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   11445:                                                     }
1.615     raeburn  11446:                                                 }
1.612     raeburn  11447:                                             }
                   11448:                                         }
1.615     raeburn  11449:                                     }
                   11450:                                     last;
1.585     raeburn  11451:                                 }
                   11452:                             }
                   11453:                         }
                   11454:                     }
                   11455:                 }
                   11456:             }
                   11457:         }
                   11458:     }
1.612     raeburn  11459:     return;
                   11460: }
                   11461: 
                   11462: sub user_rule_formats {
                   11463:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   11464:     my %text = ( 
                   11465:                  'username' => 'Usernames',
                   11466:                  'id'       => 'IDs',
                   11467:                );
                   11468:     my $output;
                   11469:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   11470:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   11471:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  11472:             $output = '<br />'.
                   11473:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   11474:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   11475:                       ' <ul>';
1.612     raeburn  11476:             foreach my $rule (@{$ruleorder}) {
                   11477:                 if (ref($curr_rules) eq 'ARRAY') {
                   11478:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   11479:                         if (ref($rules->{$rule}) eq 'HASH') {
                   11480:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   11481:                                         $rules->{$rule}{'desc'}.'</li>';
                   11482:                         }
                   11483:                     }
                   11484:                 }
                   11485:             }
                   11486:             $output .= '</ul>';
                   11487:         }
                   11488:     }
                   11489:     return $output;
                   11490: }
                   11491: 
                   11492: sub instrule_disallow_msg {
1.615     raeburn  11493:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  11494:     my $response;
                   11495:     my %text = (
                   11496:                   item   => 'username',
                   11497:                   items  => 'usernames',
                   11498:                   match  => 'matches',
                   11499:                   do     => 'does',
                   11500:                   action => 'a username',
                   11501:                   one    => 'one',
                   11502:                );
                   11503:     if ($count > 1) {
                   11504:         $text{'item'} = 'usernames';
                   11505:         $text{'match'} ='match';
                   11506:         $text{'do'} = 'do';
                   11507:         $text{'action'} = 'usernames',
                   11508:         $text{'one'} = 'ones';
                   11509:     }
                   11510:     if ($checkitem eq 'id') {
                   11511:         $text{'items'} = 'IDs';
                   11512:         $text{'item'} = 'ID';
                   11513:         $text{'action'} = 'an ID';
1.615     raeburn  11514:         if ($count > 1) {
                   11515:             $text{'item'} = 'IDs';
                   11516:             $text{'action'} = 'IDs';
                   11517:         }
1.612     raeburn  11518:     }
1.674     bisitz   11519:     $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  11520:     if ($mode eq 'upload') {
                   11521:         if ($checkitem eq 'username') {
                   11522:             $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'}.");
                   11523:         } elsif ($checkitem eq 'id') {
1.674     bisitz   11524:             $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  11525:         }
1.669     raeburn  11526:     } elsif ($mode eq 'selfcreate') {
                   11527:         if ($checkitem eq 'id') {
                   11528:             $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.");
                   11529:         }
1.615     raeburn  11530:     } else {
                   11531:         if ($checkitem eq 'username') {
                   11532:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   11533:         } elsif ($checkitem eq 'id') {
                   11534:             $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.");
                   11535:         }
1.612     raeburn  11536:     }
                   11537:     return $response;
1.585     raeburn  11538: }
                   11539: 
1.624     raeburn  11540: sub personal_data_fieldtitles {
                   11541:     my %fieldtitles = &Apache::lonlocal::texthash (
                   11542:                         id => 'Student/Employee ID',
                   11543:                         permanentemail => 'E-mail address',
                   11544:                         lastname => 'Last Name',
                   11545:                         firstname => 'First Name',
                   11546:                         middlename => 'Middle Name',
                   11547:                         generation => 'Generation',
                   11548:                         gen => 'Generation',
1.765     raeburn  11549:                         inststatus => 'Affiliation',
1.624     raeburn  11550:                    );
                   11551:     return %fieldtitles;
                   11552: }
                   11553: 
1.642     raeburn  11554: sub sorted_inst_types {
                   11555:     my ($dom) = @_;
1.1075.2.70  raeburn  11556:     my ($usertypes,$order);
                   11557:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   11558:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   11559:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   11560:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   11561:     } else {
                   11562:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   11563:     }
1.642     raeburn  11564:     my $othertitle = &mt('All users');
                   11565:     if ($env{'request.course.id'}) {
1.668     raeburn  11566:         $othertitle  = &mt('Any users');
1.642     raeburn  11567:     }
                   11568:     my @types;
                   11569:     if (ref($order) eq 'ARRAY') {
                   11570:         @types = @{$order};
                   11571:     }
                   11572:     if (@types == 0) {
                   11573:         if (ref($usertypes) eq 'HASH') {
                   11574:             @types = sort(keys(%{$usertypes}));
                   11575:         }
                   11576:     }
                   11577:     if (keys(%{$usertypes}) > 0) {
                   11578:         $othertitle = &mt('Other users');
                   11579:     }
                   11580:     return ($othertitle,$usertypes,\@types);
                   11581: }
                   11582: 
1.645     raeburn  11583: sub get_institutional_codes {
1.1075.2.157  raeburn  11584:     my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645     raeburn  11585: # Get complete list of course sections to update
                   11586:     my @currsections = ();
                   11587:     my @currxlists = ();
1.1075.2.157  raeburn  11588:     my (%unclutteredsec,%unclutteredlcsec);
1.645     raeburn  11589:     my $coursecode = $$settings{'internal.coursecode'};
1.1075.2.157  raeburn  11590:     my $crskey = $crs.':'.$coursecode;
                   11591:     @{$unclutteredsec{$crskey}} = ();
                   11592:     @{$unclutteredlcsec{$crskey}} = ();
1.645     raeburn  11593: 
                   11594:     if ($$settings{'internal.sectionnums'} ne '') {
                   11595:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   11596:     }
                   11597: 
                   11598:     if ($$settings{'internal.crosslistings'} ne '') {
                   11599:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   11600:     }
                   11601: 
                   11602:     if (@currxlists > 0) {
1.1075.2.157  raeburn  11603:         foreach my $xl (@currxlists) {
                   11604:             if ($xl =~ /^([^:]+):(\w*)$/) {
1.645     raeburn  11605:                 unless (grep/^$1$/,@{$allcourses}) {
1.1075.2.119  raeburn  11606:                     push(@{$allcourses},$1);
1.645     raeburn  11607:                     $$LC_code{$1} = $2;
                   11608:                 }
                   11609:             }
                   11610:         }
                   11611:     }
1.1075.2.157  raeburn  11612: 
1.645     raeburn  11613:     if (@currsections > 0) {
1.1075.2.157  raeburn  11614:         foreach my $sec (@currsections) {
                   11615:             if ($sec =~ m/^(\w+):(\w*)$/ ) {
                   11616:                 my $instsec = $1;
1.645     raeburn  11617:                 my $lc_sec = $2;
1.1075.2.157  raeburn  11618:                 unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
                   11619:                     push(@{$unclutteredsec{$crskey}},$instsec);
                   11620:                     push(@{$unclutteredlcsec{$crskey}},$lc_sec);
                   11621:                 }
                   11622:             }
                   11623:         }
                   11624:     }
                   11625: 
                   11626:     if (@{$unclutteredsec{$crskey}} > 0) {
                   11627:         my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
                   11628:         if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
                   11629:             for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
                   11630:                 my $sec = $coursecode.$formattedsec{$crskey}[$i];
                   11631:                 unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1075.2.119  raeburn  11632:                     push(@{$allcourses},$sec);
1.1075.2.157  raeburn  11633:                     $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645     raeburn  11634:                 }
                   11635:             }
                   11636:         }
                   11637:     }
                   11638:     return;
                   11639: }
                   11640: 
1.971     raeburn  11641: sub get_standard_codeitems {
                   11642:     return ('Year','Semester','Department','Number','Section');
                   11643: }
                   11644: 
1.112     bowersj2 11645: =pod
                   11646: 
1.780     raeburn  11647: =head1 Slot Helpers
                   11648: 
                   11649: =over 4
                   11650: 
                   11651: =item * sorted_slots()
                   11652: 
1.1040    raeburn  11653: Sorts an array of slot names in order of an optional sort key,
                   11654: default sort is by slot start time (earliest first). 
1.780     raeburn  11655: 
                   11656: Inputs:
                   11657: 
                   11658: =over 4
                   11659: 
                   11660: slotsarr  - Reference to array of unsorted slot names.
                   11661: 
                   11662: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   11663: 
1.1040    raeburn  11664: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   11665: 
1.549     albertel 11666: =back
                   11667: 
1.780     raeburn  11668: Returns:
                   11669: 
                   11670: =over 4
                   11671: 
1.1040    raeburn  11672: sorted   - An array of slot names sorted by a specified sort key 
                   11673:            (default sort key is start time of the slot).
1.780     raeburn  11674: 
                   11675: =back
                   11676: 
                   11677: =cut
                   11678: 
                   11679: 
                   11680: sub sorted_slots {
1.1040    raeburn  11681:     my ($slotsarr,$slots,$sortkey) = @_;
                   11682:     if ($sortkey eq '') {
                   11683:         $sortkey = 'starttime';
                   11684:     }
1.780     raeburn  11685:     my @sorted;
                   11686:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   11687:         @sorted =
                   11688:             sort {
                   11689:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  11690:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  11691:                      }
                   11692:                      if (ref($slots->{$a})) { return -1;}
                   11693:                      if (ref($slots->{$b})) { return 1;}
                   11694:                      return 0;
                   11695:                  } @{$slotsarr};
                   11696:     }
                   11697:     return @sorted;
                   11698: }
                   11699: 
1.1040    raeburn  11700: =pod
                   11701: 
                   11702: =item * get_future_slots()
                   11703: 
                   11704: Inputs:
                   11705: 
                   11706: =over 4
                   11707: 
                   11708: cnum - course number
                   11709: 
                   11710: cdom - course domain
                   11711: 
                   11712: now - current UNIX time
                   11713: 
                   11714: symb - optional symb
                   11715: 
                   11716: =back
                   11717: 
                   11718: Returns:
                   11719: 
                   11720: =over 4
                   11721: 
                   11722: sorted_reservable - ref to array of student_schedulable slots currently 
                   11723:                     reservable, ordered by end date of reservation period.
                   11724: 
                   11725: reservable_now - ref to hash of student_schedulable slots currently
                   11726:                  reservable.
                   11727: 
                   11728:     Keys in inner hash are:
                   11729:     (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104  raeburn  11730:     (b) endreserve: end date of reservation period.
                   11731:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   11732:         selected.
1.1040    raeburn  11733: 
                   11734: sorted_future - ref to array of student_schedulable slots reservable in
                   11735:                 the future, ordered by start date of reservation period.
                   11736: 
                   11737: future_reservable - ref to hash of student_schedulable slots reservable
                   11738:                     in the future.
                   11739: 
                   11740:     Keys in inner hash are:
                   11741:     (a) symb: either blank or symb to which slot use is restricted.
                   11742:     (b) startreserve:  start date of reservation period.
1.1075.2.104  raeburn  11743:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   11744:         selected.
1.1040    raeburn  11745: 
                   11746: =back
                   11747: 
                   11748: =cut
                   11749: 
                   11750: sub get_future_slots {
                   11751:     my ($cnum,$cdom,$now,$symb) = @_;
                   11752:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   11753:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   11754:     foreach my $slot (keys(%slots)) {
                   11755:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   11756:         if ($symb) {
                   11757:             next if (($slots{$slot}->{'symb'} ne '') && 
                   11758:                      ($slots{$slot}->{'symb'} ne $symb));
                   11759:         }
                   11760:         if (($slots{$slot}->{'starttime'} > $now) &&
                   11761:             ($slots{$slot}->{'endtime'} > $now)) {
                   11762:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   11763:                 my $userallowed = 0;
                   11764:                 if ($slots{$slot}->{'allowedsections'}) {
                   11765:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   11766:                     if (!defined($env{'request.role.sec'})
                   11767:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   11768:                         $userallowed=1;
                   11769:                     } else {
                   11770:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   11771:                             $userallowed=1;
                   11772:                         }
                   11773:                     }
                   11774:                     unless ($userallowed) {
                   11775:                         if (defined($env{'request.course.groups'})) {
                   11776:                             my @groups = split(/:/,$env{'request.course.groups'});
                   11777:                             foreach my $group (@groups) {
                   11778:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   11779:                                     $userallowed=1;
                   11780:                                     last;
                   11781:                                 }
                   11782:                             }
                   11783:                         }
                   11784:                     }
                   11785:                 }
                   11786:                 if ($slots{$slot}->{'allowedusers'}) {
                   11787:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   11788:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   11789:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   11790:                         $userallowed = 1;
                   11791:                     }
                   11792:                 }
                   11793:                 next unless($userallowed);
                   11794:             }
                   11795:             my $startreserve = $slots{$slot}->{'startreserve'};
                   11796:             my $endreserve = $slots{$slot}->{'endreserve'};
                   11797:             my $symb = $slots{$slot}->{'symb'};
1.1075.2.104  raeburn  11798:             my $uniqueperiod;
                   11799:             if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   11800:                 $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
                   11801:             }
1.1040    raeburn  11802:             if (($startreserve < $now) &&
                   11803:                 (!$endreserve || $endreserve > $now)) {
                   11804:                 my $lastres = $endreserve;
                   11805:                 if (!$lastres) {
                   11806:                     $lastres = $slots{$slot}->{'starttime'};
                   11807:                 }
                   11808:                 $reservable_now{$slot} = {
                   11809:                                            symb       => $symb,
1.1075.2.104  raeburn  11810:                                            endreserve => $lastres,
                   11811:                                            uniqueperiod => $uniqueperiod,   
1.1040    raeburn  11812:                                          };
                   11813:             } elsif (($startreserve > $now) &&
                   11814:                      (!$endreserve || $endreserve > $startreserve)) {
                   11815:                 $future_reservable{$slot} = {
                   11816:                                               symb         => $symb,
1.1075.2.104  raeburn  11817:                                               startreserve => $startreserve,
                   11818:                                               uniqueperiod => $uniqueperiod,
1.1040    raeburn  11819:                                             };
                   11820:             }
                   11821:         }
                   11822:     }
                   11823:     my @unsorted_reservable = keys(%reservable_now);
                   11824:     if (@unsorted_reservable > 0) {
                   11825:         @sorted_reservable = 
                   11826:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   11827:     }
                   11828:     my @unsorted_future = keys(%future_reservable);
                   11829:     if (@unsorted_future > 0) {
                   11830:         @sorted_future =
                   11831:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   11832:     }
                   11833:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   11834: }
1.780     raeburn  11835: 
                   11836: =pod
                   11837: 
1.1057    foxr     11838: =back
                   11839: 
1.549     albertel 11840: =head1 HTTP Helpers
                   11841: 
                   11842: =over 4
                   11843: 
1.648     raeburn  11844: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 11845: 
1.258     albertel 11846: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 11847: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 11848: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 11849: 
                   11850: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   11851: $possible_names is an ref to an array of form element names.  As an example:
                   11852: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 11853: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 11854: 
                   11855: =cut
1.1       albertel 11856: 
1.6       albertel 11857: sub get_unprocessed_cgi {
1.25      albertel 11858:   my ($query,$possible_names)= @_;
1.26      matthew  11859:   # $Apache::lonxml::debug=1;
1.356     albertel 11860:   foreach my $pair (split(/&/,$query)) {
                   11861:     my ($name, $value) = split(/=/,$pair);
1.369     www      11862:     $name = &unescape($name);
1.25      albertel 11863:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   11864:       $value =~ tr/+/ /;
                   11865:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 11866:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 11867:     }
1.16      harris41 11868:   }
1.6       albertel 11869: }
                   11870: 
1.112     bowersj2 11871: =pod
                   11872: 
1.648     raeburn  11873: =item * &cacheheader() 
1.112     bowersj2 11874: 
                   11875: returns cache-controlling header code
                   11876: 
                   11877: =cut
                   11878: 
1.7       albertel 11879: sub cacheheader {
1.258     albertel 11880:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 11881:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   11882:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 11883:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   11884:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 11885:     return $output;
1.7       albertel 11886: }
                   11887: 
1.112     bowersj2 11888: =pod
                   11889: 
1.648     raeburn  11890: =item * &no_cache($r) 
1.112     bowersj2 11891: 
                   11892: specifies header code to not have cache
                   11893: 
                   11894: =cut
                   11895: 
1.9       albertel 11896: sub no_cache {
1.216     albertel 11897:     my ($r) = @_;
                   11898:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 11899: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 11900:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   11901:     $r->no_cache(1);
                   11902:     $r->header_out("Expires" => $date);
                   11903:     $r->header_out("Pragma" => "no-cache");
1.123     www      11904: }
                   11905: 
                   11906: sub content_type {
1.181     albertel 11907:     my ($r,$type,$charset) = @_;
1.299     foxr     11908:     if ($r) {
                   11909: 	#  Note that printout.pl calls this with undef for $r.
                   11910: 	&no_cache($r);
                   11911:     }
1.258     albertel 11912:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 11913:     unless ($charset) {
                   11914: 	$charset=&Apache::lonlocal::current_encoding;
                   11915:     }
                   11916:     if ($charset) { $type.='; charset='.$charset; }
                   11917:     if ($r) {
                   11918: 	$r->content_type($type);
                   11919:     } else {
                   11920: 	print("Content-type: $type\n\n");
                   11921:     }
1.9       albertel 11922: }
1.25      albertel 11923: 
1.112     bowersj2 11924: =pod
                   11925: 
1.648     raeburn  11926: =item * &add_to_env($name,$value) 
1.112     bowersj2 11927: 
1.258     albertel 11928: adds $name to the %env hash with value
1.112     bowersj2 11929: $value, if $name already exists, the entry is converted to an array
                   11930: reference and $value is added to the array.
                   11931: 
                   11932: =cut
                   11933: 
1.25      albertel 11934: sub add_to_env {
                   11935:   my ($name,$value)=@_;
1.258     albertel 11936:   if (defined($env{$name})) {
                   11937:     if (ref($env{$name})) {
1.25      albertel 11938:       #already have multiple values
1.258     albertel 11939:       push(@{ $env{$name} },$value);
1.25      albertel 11940:     } else {
                   11941:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 11942:       my $first=$env{$name};
                   11943:       undef($env{$name});
                   11944:       push(@{ $env{$name} },$first,$value);
1.25      albertel 11945:     }
                   11946:   } else {
1.258     albertel 11947:     $env{$name}=$value;
1.25      albertel 11948:   }
1.31      albertel 11949: }
1.149     albertel 11950: 
                   11951: =pod
                   11952: 
1.648     raeburn  11953: =item * &get_env_multiple($name) 
1.149     albertel 11954: 
1.258     albertel 11955: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 11956: values may be defined and end up as an array ref.
                   11957: 
                   11958: returns an array of values
                   11959: 
                   11960: =cut
                   11961: 
                   11962: sub get_env_multiple {
                   11963:     my ($name) = @_;
                   11964:     my @values;
1.258     albertel 11965:     if (defined($env{$name})) {
1.149     albertel 11966:         # exists is it an array
1.258     albertel 11967:         if (ref($env{$name})) {
                   11968:             @values=@{ $env{$name} };
1.149     albertel 11969:         } else {
1.258     albertel 11970:             $values[0]=$env{$name};
1.149     albertel 11971:         }
                   11972:     }
                   11973:     return(@values);
                   11974: }
                   11975: 
1.660     raeburn  11976: sub ask_for_embedded_content {
                   11977:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  11978:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  11979:         %currsubfile,%unused,$rem);
1.1071    raeburn  11980:     my $counter = 0;
                   11981:     my $numnew = 0;
1.987     raeburn  11982:     my $numremref = 0;
                   11983:     my $numinvalid = 0;
                   11984:     my $numpathchg = 0;
                   11985:     my $numexisting = 0;
1.1071    raeburn  11986:     my $numunused = 0;
                   11987:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  11988:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  11989:     my $heading = &mt('Upload embedded files');
                   11990:     my $buttontext = &mt('Upload');
                   11991: 
1.1075.2.11  raeburn  11992:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  11993:         if ($actionurl eq '/adm/dependencies') {
                   11994:             $navmap = Apache::lonnavmaps::navmap->new();
                   11995:         }
                   11996:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   11997:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  11998:     }
1.1075.2.35  raeburn  11999:     if (($actionurl eq '/adm/portfolio') ||
                   12000:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  12001:         my $current_path='/';
                   12002:         if ($env{'form.currentpath'}) {
                   12003:             $current_path = $env{'form.currentpath'};
                   12004:         }
                   12005:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  12006:             $udom = $cdom;
                   12007:             $uname = $cnum;
1.984     raeburn  12008:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   12009:         } else {
                   12010:             $udom = $env{'user.domain'};
                   12011:             $uname = $env{'user.name'};
                   12012:             $url = '/userfiles/portfolio';
                   12013:         }
1.987     raeburn  12014:         $toplevel = $url.'/';
1.984     raeburn  12015:         $url .= $current_path;
                   12016:         $getpropath = 1;
1.987     raeburn  12017:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   12018:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      12019:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  12020:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  12021:         $toplevel = $url;
1.984     raeburn  12022:         if ($rest ne '') {
1.987     raeburn  12023:             $url .= $rest;
                   12024:         }
                   12025:     } elsif ($actionurl eq '/adm/coursedocs') {
                   12026:         if (ref($args) eq 'HASH') {
1.1071    raeburn  12027:             $url = $args->{'docs_url'};
                   12028:             $toplevel = $url;
1.1075.2.11  raeburn  12029:             if ($args->{'context'} eq 'paste') {
                   12030:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   12031:                 ($path) =
                   12032:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   12033:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   12034:                 $fileloc =~ s{^/}{};
                   12035:             }
1.1071    raeburn  12036:         }
                   12037:     } elsif ($actionurl eq '/adm/dependencies') {
                   12038:         if ($env{'request.course.id'} ne '') {
                   12039:             if (ref($args) eq 'HASH') {
                   12040:                 $url = $args->{'docs_url'};
                   12041:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  12042:                 $toplevel = $url;
                   12043:                 unless ($toplevel =~ m{^/}) {
                   12044:                     $toplevel = "/$url";
                   12045:                 }
1.1075.2.11  raeburn  12046:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  12047:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   12048:                     $path = $1;
                   12049:                 } else {
                   12050:                     ($path) =
                   12051:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   12052:                 }
1.1075.2.79  raeburn  12053:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   12054:                     $fileloc = $toplevel;
                   12055:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   12056:                     my ($udom,$uname,$fname) =
                   12057:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   12058:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   12059:                 } else {
                   12060:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   12061:                 }
1.1071    raeburn  12062:                 $fileloc =~ s{^/}{};
                   12063:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   12064:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   12065:             }
1.987     raeburn  12066:         }
1.1075.2.35  raeburn  12067:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   12068:         $udom = $cdom;
                   12069:         $uname = $cnum;
                   12070:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   12071:         $toplevel = $url;
                   12072:         $path = $url;
                   12073:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   12074:         $fileloc =~ s{^/}{};
                   12075:     }
                   12076:     foreach my $file (keys(%{$allfiles})) {
                   12077:         my $embed_file;
                   12078:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   12079:             $embed_file = $1;
                   12080:         } else {
                   12081:             $embed_file = $file;
                   12082:         }
1.1075.2.55  raeburn  12083:         my ($absolutepath,$cleaned_file);
                   12084:         if ($embed_file =~ m{^\w+://}) {
                   12085:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  12086:             $newfiles{$cleaned_file} = 1;
                   12087:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  12088:         } else {
1.1075.2.55  raeburn  12089:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  12090:             if ($embed_file =~ m{^/}) {
                   12091:                 $absolutepath = $embed_file;
                   12092:             }
1.1075.2.47  raeburn  12093:             if ($cleaned_file =~ m{/}) {
                   12094:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  12095:                 $path = &check_for_traversal($path,$url,$toplevel);
                   12096:                 my $item = $fname;
                   12097:                 if ($path ne '') {
                   12098:                     $item = $path.'/'.$fname;
                   12099:                     $subdependencies{$path}{$fname} = 1;
                   12100:                 } else {
                   12101:                     $dependencies{$item} = 1;
                   12102:                 }
                   12103:                 if ($absolutepath) {
                   12104:                     $mapping{$item} = $absolutepath;
                   12105:                 } else {
                   12106:                     $mapping{$item} = $embed_file;
                   12107:                 }
                   12108:             } else {
                   12109:                 $dependencies{$embed_file} = 1;
                   12110:                 if ($absolutepath) {
1.1075.2.47  raeburn  12111:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  12112:                 } else {
1.1075.2.47  raeburn  12113:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  12114:                 }
                   12115:             }
1.984     raeburn  12116:         }
                   12117:     }
1.1071    raeburn  12118:     my $dirptr = 16384;
1.984     raeburn  12119:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  12120:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  12121:         if (($actionurl eq '/adm/portfolio') ||
                   12122:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  12123:             my ($sublistref,$listerror) =
                   12124:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   12125:             if (ref($sublistref) eq 'ARRAY') {
                   12126:                 foreach my $line (@{$sublistref}) {
                   12127:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  12128:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  12129:                 }
1.984     raeburn  12130:             }
1.987     raeburn  12131:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  12132:             if (opendir(my $dir,$url.'/'.$path)) {
                   12133:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  12134:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   12135:             }
1.1075.2.11  raeburn  12136:         } elsif (($actionurl eq '/adm/dependencies') ||
                   12137:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  12138:                   ($args->{'context'} eq 'paste')) ||
                   12139:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  12140:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  12141:                 my $dir;
                   12142:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   12143:                     $dir = $fileloc;
                   12144:                 } else {
                   12145:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   12146:                 }
1.1071    raeburn  12147:                 if ($dir ne '') {
                   12148:                     my ($sublistref,$listerror) =
                   12149:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   12150:                     if (ref($sublistref) eq 'ARRAY') {
                   12151:                         foreach my $line (@{$sublistref}) {
                   12152:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   12153:                                 undef,$mtime)=split(/\&/,$line,12);
                   12154:                             unless (($testdir&$dirptr) ||
                   12155:                                     ($file_name =~ /^\.\.?$/)) {
                   12156:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   12157:                             }
                   12158:                         }
                   12159:                     }
                   12160:                 }
1.984     raeburn  12161:             }
                   12162:         }
                   12163:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  12164:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  12165:                 my $item = $path.'/'.$file;
                   12166:                 unless ($mapping{$item} eq $item) {
                   12167:                     $pathchanges{$item} = 1;
                   12168:                 }
                   12169:                 $existing{$item} = 1;
                   12170:                 $numexisting ++;
                   12171:             } else {
                   12172:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  12173:             }
                   12174:         }
1.1071    raeburn  12175:         if ($actionurl eq '/adm/dependencies') {
                   12176:             foreach my $path (keys(%currsubfile)) {
                   12177:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   12178:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   12179:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  12180:                              next if (($rem ne '') &&
                   12181:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   12182:                                        (ref($navmap) &&
                   12183:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   12184:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   12185:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  12186:                              $unused{$path.'/'.$file} = 1; 
                   12187:                          }
                   12188:                     }
                   12189:                 }
                   12190:             }
                   12191:         }
1.984     raeburn  12192:     }
1.987     raeburn  12193:     my %currfile;
1.1075.2.35  raeburn  12194:     if (($actionurl eq '/adm/portfolio') ||
                   12195:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  12196:         my ($dirlistref,$listerror) =
                   12197:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   12198:         if (ref($dirlistref) eq 'ARRAY') {
                   12199:             foreach my $line (@{$dirlistref}) {
                   12200:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   12201:                 $currfile{$file_name} = 1;
                   12202:             }
1.984     raeburn  12203:         }
1.987     raeburn  12204:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  12205:         if (opendir(my $dir,$url)) {
1.987     raeburn  12206:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  12207:             map {$currfile{$_} = 1;} @dir_list;
                   12208:         }
1.1075.2.11  raeburn  12209:     } elsif (($actionurl eq '/adm/dependencies') ||
                   12210:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  12211:               ($args->{'context'} eq 'paste')) ||
                   12212:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  12213:         if ($env{'request.course.id'} ne '') {
                   12214:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   12215:             if ($dir ne '') {
                   12216:                 my ($dirlistref,$listerror) =
                   12217:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   12218:                 if (ref($dirlistref) eq 'ARRAY') {
                   12219:                     foreach my $line (@{$dirlistref}) {
                   12220:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   12221:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   12222:                         unless (($testdir&$dirptr) ||
                   12223:                                 ($file_name =~ /^\.\.?$/)) {
                   12224:                             $currfile{$file_name} = [$size,$mtime];
                   12225:                         }
                   12226:                     }
                   12227:                 }
                   12228:             }
                   12229:         }
1.984     raeburn  12230:     }
                   12231:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  12232:         if (exists($currfile{$file})) {
1.987     raeburn  12233:             unless ($mapping{$file} eq $file) {
                   12234:                 $pathchanges{$file} = 1;
                   12235:             }
                   12236:             $existing{$file} = 1;
                   12237:             $numexisting ++;
                   12238:         } else {
1.984     raeburn  12239:             $newfiles{$file} = 1;
                   12240:         }
                   12241:     }
1.1071    raeburn  12242:     foreach my $file (keys(%currfile)) {
                   12243:         unless (($file eq $filename) ||
                   12244:                 ($file eq $filename.'.bak') ||
                   12245:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  12246:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  12247:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   12248:                     next if (($rem ne '') &&
                   12249:                              (($env{"httpref.$rem".$file} ne '') ||
                   12250:                               (ref($navmap) &&
                   12251:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   12252:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   12253:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   12254:                 }
1.1075.2.11  raeburn  12255:             }
1.1071    raeburn  12256:             $unused{$file} = 1;
                   12257:         }
                   12258:     }
1.1075.2.11  raeburn  12259:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   12260:         ($args->{'context'} eq 'paste')) {
                   12261:         $counter = scalar(keys(%existing));
                   12262:         $numpathchg = scalar(keys(%pathchanges));
                   12263:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  12264:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   12265:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   12266:         $counter = scalar(keys(%existing));
                   12267:         $numpathchg = scalar(keys(%pathchanges));
                   12268:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  12269:     }
1.984     raeburn  12270:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  12271:         if ($actionurl eq '/adm/dependencies') {
                   12272:             next if ($embed_file =~ m{^\w+://});
                   12273:         }
1.660     raeburn  12274:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  12275:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  12276:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  12277:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  12278:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   12279:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  12280:         }
1.1075.2.35  raeburn  12281:         $upload_output .= '</td>';
1.1071    raeburn  12282:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  12283:             $upload_output.='<td align="right">'.
                   12284:                             '<span class="LC_info LC_fontsize_medium">'.
                   12285:                             &mt("URL points to web address").'</span>';
1.987     raeburn  12286:             $numremref++;
1.660     raeburn  12287:         } elsif ($args->{'error_on_invalid_names'}
                   12288:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  12289:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   12290:                             &mt('Invalid characters').'</span>';
1.987     raeburn  12291:             $numinvalid++;
1.660     raeburn  12292:         } else {
1.1075.2.35  raeburn  12293:             $upload_output .= '<td>'.
                   12294:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  12295:                                                      $embed_file,\%mapping,
1.1071    raeburn  12296:                                                      $allfiles,$codebase,'upload');
                   12297:             $counter ++;
                   12298:             $numnew ++;
1.987     raeburn  12299:         }
                   12300:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   12301:     }
                   12302:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  12303:         if ($actionurl eq '/adm/dependencies') {
                   12304:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   12305:             $modify_output .= &start_data_table_row().
                   12306:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   12307:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   12308:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   12309:                               '<td>'.$size.'</td>'.
                   12310:                               '<td>'.$mtime.'</td>'.
                   12311:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   12312:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   12313:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   12314:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   12315:                               &embedded_file_element('upload_embedded',$counter,
                   12316:                                                      $embed_file,\%mapping,
                   12317:                                                      $allfiles,$codebase,'modify').
                   12318:                               '</div></td>'.
                   12319:                               &end_data_table_row()."\n";
                   12320:             $counter ++;
                   12321:         } else {
                   12322:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  12323:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   12324:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   12325:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  12326:                               &Apache::loncommon::end_data_table_row()."\n";
                   12327:         }
                   12328:     }
                   12329:     my $delidx = $counter;
                   12330:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   12331:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   12332:         $delete_output .= &start_data_table_row().
                   12333:                           '<td><img src="'.&icon($oldfile).'" />'.
                   12334:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   12335:                           '<td>'.$size.'</td>'.
                   12336:                           '<td>'.$mtime.'</td>'.
                   12337:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   12338:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   12339:                           &embedded_file_element('upload_embedded',$delidx,
                   12340:                                                  $oldfile,\%mapping,$allfiles,
                   12341:                                                  $codebase,'delete').'</td>'.
                   12342:                           &end_data_table_row()."\n"; 
                   12343:         $numunused ++;
                   12344:         $delidx ++;
1.987     raeburn  12345:     }
                   12346:     if ($upload_output) {
                   12347:         $upload_output = &start_data_table().
                   12348:                          $upload_output.
                   12349:                          &end_data_table()."\n";
                   12350:     }
1.1071    raeburn  12351:     if ($modify_output) {
                   12352:         $modify_output = &start_data_table().
                   12353:                          &start_data_table_header_row().
                   12354:                          '<th>'.&mt('File').'</th>'.
                   12355:                          '<th>'.&mt('Size (KB)').'</th>'.
                   12356:                          '<th>'.&mt('Modified').'</th>'.
                   12357:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   12358:                          &end_data_table_header_row().
                   12359:                          $modify_output.
                   12360:                          &end_data_table()."\n";
                   12361:     }
                   12362:     if ($delete_output) {
                   12363:         $delete_output = &start_data_table().
                   12364:                          &start_data_table_header_row().
                   12365:                          '<th>'.&mt('File').'</th>'.
                   12366:                          '<th>'.&mt('Size (KB)').'</th>'.
                   12367:                          '<th>'.&mt('Modified').'</th>'.
                   12368:                          '<th>'.&mt('Delete?').'</th>'.
                   12369:                          &end_data_table_header_row().
                   12370:                          $delete_output.
                   12371:                          &end_data_table()."\n";
                   12372:     }
1.987     raeburn  12373:     my $applies = 0;
                   12374:     if ($numremref) {
                   12375:         $applies ++;
                   12376:     }
                   12377:     if ($numinvalid) {
                   12378:         $applies ++;
                   12379:     }
                   12380:     if ($numexisting) {
                   12381:         $applies ++;
                   12382:     }
1.1071    raeburn  12383:     if ($counter || $numunused) {
1.987     raeburn  12384:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   12385:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  12386:                   $state.'<h3>'.$heading.'</h3>'; 
                   12387:         if ($actionurl eq '/adm/dependencies') {
                   12388:             if ($numnew) {
                   12389:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   12390:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   12391:                            $upload_output.'<br />'."\n";
                   12392:             }
                   12393:             if ($numexisting) {
                   12394:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   12395:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   12396:                            $modify_output.'<br />'."\n";
                   12397:                            $buttontext = &mt('Save changes');
                   12398:             }
                   12399:             if ($numunused) {
                   12400:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   12401:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   12402:                            $delete_output.'<br />'."\n";
                   12403:                            $buttontext = &mt('Save changes');
                   12404:             }
                   12405:         } else {
                   12406:             $output .= $upload_output.'<br />'."\n";
                   12407:         }
                   12408:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   12409:                    $counter.'" />'."\n";
                   12410:         if ($actionurl eq '/adm/dependencies') { 
                   12411:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   12412:                        $numnew.'" />'."\n";
                   12413:         } elsif ($actionurl eq '') {
1.987     raeburn  12414:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   12415:         }
                   12416:     } elsif ($applies) {
                   12417:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   12418:         if ($applies > 1) {
                   12419:             $output .=  
1.1075.2.35  raeburn  12420:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  12421:             if ($numremref) {
                   12422:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   12423:             }
                   12424:             if ($numinvalid) {
                   12425:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   12426:             }
                   12427:             if ($numexisting) {
                   12428:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   12429:             }
                   12430:             $output .= '</ul><br />';
                   12431:         } elsif ($numremref) {
                   12432:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   12433:         } elsif ($numinvalid) {
                   12434:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   12435:         } elsif ($numexisting) {
                   12436:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   12437:         }
                   12438:         $output .= $upload_output.'<br />';
                   12439:     }
                   12440:     my ($pathchange_output,$chgcount);
1.1071    raeburn  12441:     $chgcount = $counter;
1.987     raeburn  12442:     if (keys(%pathchanges) > 0) {
                   12443:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  12444:             if ($counter) {
1.987     raeburn  12445:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   12446:                                                   $embed_file,\%mapping,
1.1071    raeburn  12447:                                                   $allfiles,$codebase,'change');
1.987     raeburn  12448:             } else {
                   12449:                 $pathchange_output .= 
                   12450:                     &start_data_table_row().
                   12451:                     '<td><input type ="checkbox" name="namechange" value="'.
                   12452:                     $chgcount.'" checked="checked" /></td>'.
                   12453:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   12454:                     '<td>'.$embed_file.
                   12455:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  12456:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  12457:                     '</td>'.&end_data_table_row();
1.660     raeburn  12458:             }
1.987     raeburn  12459:             $numpathchg ++;
                   12460:             $chgcount ++;
1.660     raeburn  12461:         }
                   12462:     }
1.1075.2.35  raeburn  12463:     if (($counter) || ($numunused)) {
1.987     raeburn  12464:         if ($numpathchg) {
                   12465:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   12466:                        $numpathchg.'" />'."\n";
                   12467:         }
                   12468:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   12469:             ($actionurl eq '/adm/imsimport')) {
                   12470:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   12471:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   12472:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  12473:         } elsif ($actionurl eq '/adm/dependencies') {
                   12474:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  12475:         }
1.1075.2.35  raeburn  12476:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  12477:     } elsif ($numpathchg) {
                   12478:         my %pathchange = ();
                   12479:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   12480:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   12481:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  12482:         }
1.987     raeburn  12483:     }
1.1071    raeburn  12484:     return ($output,$counter,$numpathchg);
1.987     raeburn  12485: }
                   12486: 
1.1075.2.47  raeburn  12487: =pod
                   12488: 
                   12489: =item * clean_path($name)
                   12490: 
                   12491: Performs clean-up of directories, subdirectories and filename in an
                   12492: embedded object, referenced in an HTML file which is being uploaded
                   12493: to a course or portfolio, where
                   12494: "Upload embedded images/multimedia files if HTML file" checkbox was
                   12495: checked.
                   12496: 
                   12497: Clean-up is similar to replacements in lonnet::clean_filename()
                   12498: except each / between sub-directory and next level is preserved.
                   12499: 
                   12500: =cut
                   12501: 
                   12502: sub clean_path {
                   12503:     my ($embed_file) = @_;
                   12504:     $embed_file =~s{^/+}{};
                   12505:     my @contents;
                   12506:     if ($embed_file =~ m{/}) {
                   12507:         @contents = split(/\//,$embed_file);
                   12508:     } else {
                   12509:         @contents = ($embed_file);
                   12510:     }
                   12511:     my $lastidx = scalar(@contents)-1;
                   12512:     for (my $i=0; $i<=$lastidx; $i++) {
                   12513:         $contents[$i]=~s{\\}{/}g;
                   12514:         $contents[$i]=~s/\s+/\_/g;
                   12515:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   12516:         if ($i == $lastidx) {
                   12517:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   12518:         }
                   12519:     }
                   12520:     if ($lastidx > 0) {
                   12521:         return join('/',@contents);
                   12522:     } else {
                   12523:         return $contents[0];
                   12524:     }
                   12525: }
                   12526: 
1.987     raeburn  12527: sub embedded_file_element {
1.1071    raeburn  12528:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  12529:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   12530:                    (ref($codebase) eq 'HASH'));
                   12531:     my $output;
1.1071    raeburn  12532:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  12533:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   12534:     }
                   12535:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   12536:                &escape($embed_file).'" />';
                   12537:     unless (($context eq 'upload_embedded') && 
                   12538:             ($mapping->{$embed_file} eq $embed_file)) {
                   12539:         $output .='
                   12540:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   12541:     }
                   12542:     my $attrib;
                   12543:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   12544:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   12545:     }
                   12546:     $output .=
                   12547:         "\n\t\t".
                   12548:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   12549:         $attrib.'" />';
                   12550:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   12551:         $output .=
                   12552:             "\n\t\t".
                   12553:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   12554:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  12555:     }
1.987     raeburn  12556:     return $output;
1.660     raeburn  12557: }
                   12558: 
1.1071    raeburn  12559: sub get_dependency_details {
                   12560:     my ($currfile,$currsubfile,$embed_file) = @_;
                   12561:     my ($size,$mtime,$showsize,$showmtime);
                   12562:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   12563:         if ($embed_file =~ m{/}) {
                   12564:             my ($path,$fname) = split(/\//,$embed_file);
                   12565:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   12566:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   12567:             }
                   12568:         } else {
                   12569:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   12570:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   12571:             }
                   12572:         }
                   12573:         $showsize = $size/1024.0;
                   12574:         $showsize = sprintf("%.1f",$showsize);
                   12575:         if ($mtime > 0) {
                   12576:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   12577:         }
                   12578:     }
                   12579:     return ($showsize,$showmtime);
                   12580: }
                   12581: 
                   12582: sub ask_embedded_js {
                   12583:     return <<"END";
                   12584: <script type="text/javascript"">
                   12585: // <![CDATA[
                   12586: function toggleBrowse(counter) {
                   12587:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   12588:     var fileid = document.getElementById('embedded_item_'+counter);
                   12589:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   12590:     if (chkboxid.checked == true) {
                   12591:         uploaddivid.style.display='block';
                   12592:     } else {
                   12593:         uploaddivid.style.display='none';
                   12594:         fileid.value = '';
                   12595:     }
                   12596: }
                   12597: // ]]>
                   12598: </script>
                   12599: 
                   12600: END
                   12601: }
                   12602: 
1.661     raeburn  12603: sub upload_embedded {
                   12604:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  12605:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   12606:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  12607:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   12608:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   12609:         my $orig_uploaded_filename =
                   12610:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  12611:         foreach my $type ('orig','ref','attrib','codebase') {
                   12612:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   12613:                 $env{'form.embedded_'.$type.'_'.$i} =
                   12614:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   12615:             }
                   12616:         }
1.661     raeburn  12617:         my ($path,$fname) =
                   12618:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   12619:         # no path, whole string is fname
                   12620:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   12621:         $fname = &Apache::lonnet::clean_filename($fname);
                   12622:         # See if there is anything left
                   12623:         next if ($fname eq '');
                   12624: 
                   12625:         # Check if file already exists as a file or directory.
                   12626:         my ($state,$msg);
                   12627:         if ($context eq 'portfolio') {
                   12628:             my $port_path = $dirpath;
                   12629:             if ($group ne '') {
                   12630:                 $port_path = "groups/$group/$port_path";
                   12631:             }
1.987     raeburn  12632:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   12633:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  12634:                                               $dir_root,$port_path,$disk_quota,
                   12635:                                               $current_disk_usage,$uname,$udom);
                   12636:             if ($state eq 'will_exceed_quota'
1.984     raeburn  12637:                 || $state eq 'file_locked') {
1.661     raeburn  12638:                 $output .= $msg;
                   12639:                 next;
                   12640:             }
                   12641:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   12642:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   12643:             if ($state eq 'exists') {
                   12644:                 $output .= $msg;
                   12645:                 next;
                   12646:             }
                   12647:         }
                   12648:         # Check if extension is valid
                   12649:         if (($fname =~ /\.(\w+)$/) &&
                   12650:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  12651:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   12652:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  12653:             next;
                   12654:         } elsif (($fname =~ /\.(\w+)$/) &&
                   12655:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  12656:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  12657:             next;
                   12658:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  12659:             $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  12660:             next;
                   12661:         }
                   12662:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  12663:         my $subdir = $path;
                   12664:         $subdir =~ s{/+$}{};
1.661     raeburn  12665:         if ($context eq 'portfolio') {
1.984     raeburn  12666:             my $result;
                   12667:             if ($state eq 'existingfile') {
                   12668:                 $result=
                   12669:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  12670:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  12671:             } else {
1.984     raeburn  12672:                 $result=
                   12673:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  12674:                                                     $dirpath.
1.1075.2.35  raeburn  12675:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  12676:                 if ($result !~ m|^/uploaded/|) {
                   12677:                     $output .= '<span class="LC_error">'
                   12678:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   12679:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   12680:                                .'</span><br />';
                   12681:                     next;
                   12682:                 } else {
1.987     raeburn  12683:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   12684:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  12685:                 }
1.661     raeburn  12686:             }
1.1075.2.35  raeburn  12687:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   12688:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   12689:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  12690:             my $result =
1.1075.2.35  raeburn  12691:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  12692:             if ($result !~ m|^/uploaded/|) {
                   12693:                 $output .= '<span class="LC_error">'
                   12694:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   12695:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   12696:                            .'</span><br />';
                   12697:                     next;
                   12698:             } else {
                   12699:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   12700:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  12701:                 if ($context eq 'syllabus') {
                   12702:                     &Apache::lonnet::make_public_indefinitely($result);
                   12703:                 }
1.987     raeburn  12704:             }
1.661     raeburn  12705:         } else {
                   12706: # Save the file
                   12707:             my $target = $env{'form.embedded_item_'.$i};
                   12708:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   12709:             my $dest = $fullpath.$fname;
                   12710:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  12711:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  12712:             my $count;
                   12713:             my $filepath = $dir_root;
1.1027    raeburn  12714:             foreach my $subdir (@parts) {
                   12715:                 $filepath .= "/$subdir";
                   12716:                 if (!-e $filepath) {
1.661     raeburn  12717:                     mkdir($filepath,0770);
                   12718:                 }
                   12719:             }
                   12720:             my $fh;
                   12721:             if (!open($fh,'>'.$dest)) {
                   12722:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   12723:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  12724:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   12725:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  12726:                            '</span><br />';
                   12727:             } else {
                   12728:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   12729:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   12730:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  12731:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   12732:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  12733:                               '</span><br />';
                   12734:                 } else {
1.987     raeburn  12735:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   12736:                                $url.'</span>').'<br />';
                   12737:                     unless ($context eq 'testbank') {
                   12738:                         $footer .= &mt('View embedded file: [_1]',
                   12739:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   12740:                     }
                   12741:                 }
                   12742:                 close($fh);
                   12743:             }
                   12744:         }
                   12745:         if ($env{'form.embedded_ref_'.$i}) {
                   12746:             $pathchange{$i} = 1;
                   12747:         }
                   12748:     }
                   12749:     if ($output) {
                   12750:         $output = '<p>'.$output.'</p>';
                   12751:     }
                   12752:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   12753:     $returnflag = 'ok';
1.1071    raeburn  12754:     my $numpathchgs = scalar(keys(%pathchange));
                   12755:     if ($numpathchgs > 0) {
1.987     raeburn  12756:         if ($context eq 'portfolio') {
                   12757:             $output .= '<p>'.&mt('or').'</p>';
                   12758:         } elsif ($context eq 'testbank') {
1.1071    raeburn  12759:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   12760:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  12761:             $returnflag = 'modify_orightml';
                   12762:         }
                   12763:     }
1.1071    raeburn  12764:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  12765: }
                   12766: 
                   12767: sub modify_html_form {
                   12768:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   12769:     my $end = 0;
                   12770:     my $modifyform;
                   12771:     if ($context eq 'upload_embedded') {
                   12772:         return unless (ref($pathchange) eq 'HASH');
                   12773:         if ($env{'form.number_embedded_items'}) {
                   12774:             $end += $env{'form.number_embedded_items'};
                   12775:         }
                   12776:         if ($env{'form.number_pathchange_items'}) {
                   12777:             $end += $env{'form.number_pathchange_items'};
                   12778:         }
                   12779:         if ($end) {
                   12780:             for (my $i=0; $i<$end; $i++) {
                   12781:                 if ($i < $env{'form.number_embedded_items'}) {
                   12782:                     next unless($pathchange->{$i});
                   12783:                 }
                   12784:                 $modifyform .=
                   12785:                     &start_data_table_row().
                   12786:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   12787:                     'checked="checked" /></td>'.
                   12788:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   12789:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   12790:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   12791:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   12792:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   12793:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   12794:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   12795:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   12796:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   12797:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   12798:                     &end_data_table_row();
1.1071    raeburn  12799:             }
1.987     raeburn  12800:         }
                   12801:     } else {
                   12802:         $modifyform = $pathchgtable;
                   12803:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   12804:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   12805:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   12806:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   12807:         }
                   12808:     }
                   12809:     if ($modifyform) {
1.1071    raeburn  12810:         if ($actionurl eq '/adm/dependencies') {
                   12811:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   12812:         }
1.987     raeburn  12813:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   12814:                '<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".
                   12815:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   12816:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   12817:                '</ol></p>'."\n".'<p>'.
                   12818:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   12819:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   12820:                &start_data_table()."\n".
                   12821:                &start_data_table_header_row().
                   12822:                '<th>'.&mt('Change?').'</th>'.
                   12823:                '<th>'.&mt('Current reference').'</th>'.
                   12824:                '<th>'.&mt('Required reference').'</th>'.
                   12825:                &end_data_table_header_row()."\n".
                   12826:                $modifyform.
                   12827:                &end_data_table().'<br />'."\n".$hiddenstate.
                   12828:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   12829:                '</form>'."\n";
                   12830:     }
                   12831:     return;
                   12832: }
                   12833: 
                   12834: sub modify_html_refs {
1.1075.2.35  raeburn  12835:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  12836:     my $container;
                   12837:     if ($context eq 'portfolio') {
                   12838:         $container = $env{'form.container'};
                   12839:     } elsif ($context eq 'coursedoc') {
                   12840:         $container = $env{'form.primaryurl'};
1.1071    raeburn  12841:     } elsif ($context eq 'manage_dependencies') {
                   12842:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   12843:         $container = "/$container";
1.1075.2.35  raeburn  12844:     } elsif ($context eq 'syllabus') {
                   12845:         $container = $url;
1.987     raeburn  12846:     } else {
1.1027    raeburn  12847:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  12848:     }
                   12849:     my (%allfiles,%codebase,$output,$content);
                   12850:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  12851:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  12852:         if (wantarray) {
                   12853:             return ('',0,0); 
                   12854:         } else {
                   12855:             return;
                   12856:         }
                   12857:     }
                   12858:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  12859:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  12860:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   12861:             if (wantarray) {
                   12862:                 return ('',0,0);
                   12863:             } else {
                   12864:                 return;
                   12865:             }
                   12866:         } 
1.987     raeburn  12867:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  12868:         if ($content eq '-1') {
                   12869:             if (wantarray) {
                   12870:                 return ('',0,0);
                   12871:             } else {
                   12872:                 return;
                   12873:             }
                   12874:         }
1.987     raeburn  12875:     } else {
1.1071    raeburn  12876:         unless ($container =~ /^\Q$dir_root\E/) {
                   12877:             if (wantarray) {
                   12878:                 return ('',0,0);
                   12879:             } else {
                   12880:                 return;
                   12881:             }
                   12882:         } 
1.1075.2.128  raeburn  12883:         if (open(my $fh,'<',$container)) {
1.987     raeburn  12884:             $content = join('', <$fh>);
                   12885:             close($fh);
                   12886:         } else {
1.1071    raeburn  12887:             if (wantarray) {
                   12888:                 return ('',0,0);
                   12889:             } else {
                   12890:                 return;
                   12891:             }
1.987     raeburn  12892:         }
                   12893:     }
                   12894:     my ($count,$codebasecount) = (0,0);
                   12895:     my $mm = new File::MMagic;
                   12896:     my $mime_type = $mm->checktype_contents($content);
                   12897:     if ($mime_type eq 'text/html') {
                   12898:         my $parse_result = 
                   12899:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   12900:                                                     \%codebase,\$content);
                   12901:         if ($parse_result eq 'ok') {
                   12902:             foreach my $i (@changes) {
                   12903:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   12904:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   12905:                 if ($allfiles{$ref}) {
                   12906:                     my $newname =  $orig;
                   12907:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  12908:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  12909:                     if ($attrib_regexp =~ /:/) {
                   12910:                         $attrib_regexp =~ s/\:/|/g;
                   12911:                     }
                   12912:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   12913:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   12914:                         $count += $numchg;
1.1075.2.35  raeburn  12915:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  12916:                         delete($allfiles{$ref});
1.987     raeburn  12917:                     }
                   12918:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  12919:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  12920:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   12921:                         $codebasecount ++;
                   12922:                     }
                   12923:                 }
                   12924:             }
1.1075.2.35  raeburn  12925:             my $skiprewrites;
1.987     raeburn  12926:             if ($count || $codebasecount) {
                   12927:                 my $saveresult;
1.1071    raeburn  12928:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  12929:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  12930:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   12931:                     if ($url eq $container) {
                   12932:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   12933:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   12934:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  12935:                                             $fname.'</span>').'</p>';
1.987     raeburn  12936:                     } else {
                   12937:                          $output = '<p class="LC_error">'.
                   12938:                                    &mt('Error: update failed for: [_1].',
                   12939:                                    '<span class="LC_filename">'.
                   12940:                                    $container.'</span>').'</p>';
                   12941:                     }
1.1075.2.35  raeburn  12942:                     if ($context eq 'syllabus') {
                   12943:                         unless ($saveresult eq 'ok') {
                   12944:                             $skiprewrites = 1;
                   12945:                         }
                   12946:                     }
1.987     raeburn  12947:                 } else {
1.1075.2.128  raeburn  12948:                     if (open(my $fh,'>',$container)) {
1.987     raeburn  12949:                         print $fh $content;
                   12950:                         close($fh);
                   12951:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   12952:                                   $count,'<span class="LC_filename">'.
                   12953:                                   $container.'</span>').'</p>';
1.661     raeburn  12954:                     } else {
1.987     raeburn  12955:                          $output = '<p class="LC_error">'.
                   12956:                                    &mt('Error: could not update [_1].',
                   12957:                                    '<span class="LC_filename">'.
                   12958:                                    $container.'</span>').'</p>';
1.661     raeburn  12959:                     }
                   12960:                 }
                   12961:             }
1.1075.2.35  raeburn  12962:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   12963:                 my ($actionurl,$state);
                   12964:                 $actionurl = "/public/$udom/$uname/syllabus";
                   12965:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   12966:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   12967:                                               \%codebase,
                   12968:                                               {'context' => 'rewrites',
                   12969:                                                'ignore_remote_references' => 1,});
                   12970:                 if (ref($mapping) eq 'HASH') {
                   12971:                     my $rewrites = 0;
                   12972:                     foreach my $key (keys(%{$mapping})) {
                   12973:                         next if ($key =~ m{^https?://});
                   12974:                         my $ref = $mapping->{$key};
                   12975:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   12976:                         my $attrib;
                   12977:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   12978:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   12979:                         }
                   12980:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   12981:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   12982:                             $rewrites += $numchg;
                   12983:                         }
                   12984:                     }
                   12985:                     if ($rewrites) {
                   12986:                         my $saveresult;
                   12987:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   12988:                         if ($url eq $container) {
                   12989:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   12990:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   12991:                                             $count,'<span class="LC_filename">'.
                   12992:                                             $fname.'</span>').'</p>';
                   12993:                         } else {
                   12994:                             $output .= '<p class="LC_error">'.
                   12995:                                        &mt('Error: could not update links in [_1].',
                   12996:                                        '<span class="LC_filename">'.
                   12997:                                        $container.'</span>').'</p>';
                   12998: 
                   12999:                         }
                   13000:                     }
                   13001:                 }
                   13002:             }
1.987     raeburn  13003:         } else {
                   13004:             &logthis('Failed to parse '.$container.
                   13005:                      ' to modify references: '.$parse_result);
1.661     raeburn  13006:         }
                   13007:     }
1.1071    raeburn  13008:     if (wantarray) {
                   13009:         return ($output,$count,$codebasecount);
                   13010:     } else {
                   13011:         return $output;
                   13012:     }
1.661     raeburn  13013: }
                   13014: 
                   13015: sub check_for_existing {
                   13016:     my ($path,$fname,$element) = @_;
                   13017:     my ($state,$msg);
                   13018:     if (-d $path.'/'.$fname) {
                   13019:         $state = 'exists';
                   13020:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   13021:     } elsif (-e $path.'/'.$fname) {
                   13022:         $state = 'exists';
                   13023:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   13024:     }
                   13025:     if ($state eq 'exists') {
                   13026:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   13027:     }
                   13028:     return ($state,$msg);
                   13029: }
                   13030: 
                   13031: sub check_for_upload {
                   13032:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   13033:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  13034:     my $filesize = length($env{'form.'.$element});
                   13035:     if (!$filesize) {
                   13036:         my $msg = '<span class="LC_error">'.
                   13037:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   13038:                       '<span class="LC_filename">'.$fname.'</span>',
                   13039:                       $filesize).'<br />'.
1.1007    raeburn  13040:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  13041:                   '</span>';
                   13042:         return ('zero_bytes',$msg);
                   13043:     }
                   13044:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  13045:     my $getpropath = 1;
1.1021    raeburn  13046:     my ($dirlistref,$listerror) =
                   13047:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  13048:     my $found_file = 0;
                   13049:     my $locked_file = 0;
1.991     raeburn  13050:     my @lockers;
                   13051:     my $navmap;
                   13052:     if ($env{'request.course.id'}) {
                   13053:         $navmap = Apache::lonnavmaps::navmap->new();
                   13054:     }
1.1021    raeburn  13055:     if (ref($dirlistref) eq 'ARRAY') {
                   13056:         foreach my $line (@{$dirlistref}) {
                   13057:             my ($file_name,$rest)=split(/\&/,$line,2);
                   13058:             if ($file_name eq $fname){
                   13059:                 $file_name = $path.$file_name;
                   13060:                 if ($group ne '') {
                   13061:                     $file_name = $group.$file_name;
                   13062:                 }
                   13063:                 $found_file = 1;
                   13064:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   13065:                     foreach my $lock (@lockers) {
                   13066:                         if (ref($lock) eq 'ARRAY') {
                   13067:                             my ($symb,$crsid) = @{$lock};
                   13068:                             if ($crsid eq $env{'request.course.id'}) {
                   13069:                                 if (ref($navmap)) {
                   13070:                                     my $res = $navmap->getBySymb($symb);
                   13071:                                     foreach my $part (@{$res->parts()}) { 
                   13072:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   13073:                                         unless (($slot_status == $res->RESERVED) ||
                   13074:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   13075:                                             $locked_file = 1;
                   13076:                                         }
1.991     raeburn  13077:                                     }
1.1021    raeburn  13078:                                 } else {
                   13079:                                     $locked_file = 1;
1.991     raeburn  13080:                                 }
                   13081:                             } else {
                   13082:                                 $locked_file = 1;
                   13083:                             }
                   13084:                         }
1.1021    raeburn  13085:                    }
                   13086:                 } else {
                   13087:                     my @info = split(/\&/,$rest);
                   13088:                     my $currsize = $info[6]/1000;
                   13089:                     if ($currsize < $filesize) {
                   13090:                         my $extra = $filesize - $currsize;
                   13091:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  13092:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  13093:                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
1.1075.2.69  raeburn  13094:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   13095:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   13096:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  13097:                             return ('will_exceed_quota',$msg);
                   13098:                         }
1.984     raeburn  13099:                     }
                   13100:                 }
1.661     raeburn  13101:             }
                   13102:         }
                   13103:     }
                   13104:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  13105:         my $msg = '<p class="LC_warning">'.
                   13106:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   13107:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  13108:         return ('will_exceed_quota',$msg);
                   13109:     } elsif ($found_file) {
                   13110:         if ($locked_file) {
1.1075.2.69  raeburn  13111:             my $msg = '<p class="LC_warning">';
1.661     raeburn  13112:             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
1.1075.2.69  raeburn  13113:             $msg .= '</p>';
1.661     raeburn  13114:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   13115:             return ('file_locked',$msg);
                   13116:         } else {
1.1075.2.69  raeburn  13117:             my $msg = '<p class="LC_error">';
1.984     raeburn  13118:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1075.2.69  raeburn  13119:             $msg .= '</p>';
1.984     raeburn  13120:             return ('existingfile',$msg);
1.661     raeburn  13121:         }
                   13122:     }
                   13123: }
                   13124: 
1.987     raeburn  13125: sub check_for_traversal {
                   13126:     my ($path,$url,$toplevel) = @_;
                   13127:     my @parts=split(/\//,$path);
                   13128:     my $cleanpath;
                   13129:     my $fullpath = $url;
                   13130:     for (my $i=0;$i<@parts;$i++) {
                   13131:         next if ($parts[$i] eq '.');
                   13132:         if ($parts[$i] eq '..') {
                   13133:             $fullpath =~ s{([^/]+/)$}{};
                   13134:         } else {
                   13135:             $fullpath .= $parts[$i].'/';
                   13136:         }
                   13137:     }
                   13138:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   13139:         $cleanpath = $1;
                   13140:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   13141:         my $curr_toprel = $1;
                   13142:         my @parts = split(/\//,$curr_toprel);
                   13143:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   13144:         my @urlparts = split(/\//,$url_toprel);
                   13145:         my $doubledots;
                   13146:         my $startdiff = -1;
                   13147:         for (my $i=0; $i<@urlparts; $i++) {
                   13148:             if ($startdiff == -1) {
                   13149:                 unless ($urlparts[$i] eq $parts[$i]) {
                   13150:                     $startdiff = $i;
                   13151:                     $doubledots .= '../';
                   13152:                 }
                   13153:             } else {
                   13154:                 $doubledots .= '../';
                   13155:             }
                   13156:         }
                   13157:         if ($startdiff > -1) {
                   13158:             $cleanpath = $doubledots;
                   13159:             for (my $i=$startdiff; $i<@parts; $i++) {
                   13160:                 $cleanpath .= $parts[$i].'/';
                   13161:             }
                   13162:         }
                   13163:     }
                   13164:     $cleanpath =~ s{(/)$}{};
                   13165:     return $cleanpath;
                   13166: }
1.31      albertel 13167: 
1.1053    raeburn  13168: sub is_archive_file {
                   13169:     my ($mimetype) = @_;
                   13170:     if (($mimetype eq 'application/octet-stream') ||
                   13171:         ($mimetype eq 'application/x-stuffit') ||
                   13172:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   13173:         return 1;
                   13174:     }
                   13175:     return;
                   13176: }
                   13177: 
                   13178: sub decompress_form {
1.1065    raeburn  13179:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  13180:     my %lt = &Apache::lonlocal::texthash (
                   13181:         this => 'This file is an archive file.',
1.1067    raeburn  13182:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  13183:         itsc => 'Its contents are as follows:',
1.1053    raeburn  13184:         youm => 'You may wish to extract its contents.',
                   13185:         extr => 'Extract contents',
1.1067    raeburn  13186:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   13187:         proa => 'Process automatically?',
1.1053    raeburn  13188:         yes  => 'Yes',
                   13189:         no   => 'No',
1.1067    raeburn  13190:         fold => 'Title for folder containing movie',
                   13191:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  13192:     );
1.1065    raeburn  13193:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  13194:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  13195:     my $info = &list_archive_contents($fileloc,\@paths);
                   13196:     if (@paths) {
                   13197:         foreach my $path (@paths) {
                   13198:             $path =~ s{^/}{};
1.1067    raeburn  13199:             if ($path =~ m{^([^/]+)/$}) {
                   13200:                 $topdir = $1;
                   13201:             }
1.1065    raeburn  13202:             if ($path =~ m{^([^/]+)/}) {
                   13203:                 $toplevel{$1} = $path;
                   13204:             } else {
                   13205:                 $toplevel{$path} = $path;
                   13206:             }
                   13207:         }
                   13208:     }
1.1067    raeburn  13209:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  13210:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  13211:                         "$topdir/media/",
                   13212:                         "$topdir/media/$topdir.mp4",
                   13213:                         "$topdir/media/FirstFrame.png",
                   13214:                         "$topdir/media/player.swf",
                   13215:                         "$topdir/media/swfobject.js",
                   13216:                         "$topdir/media/expressInstall.swf");
1.1075.2.81  raeburn  13217:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59  raeburn  13218:                          "$topdir/$topdir.mp4",
                   13219:                          "$topdir/$topdir\_config.xml",
                   13220:                          "$topdir/$topdir\_controller.swf",
                   13221:                          "$topdir/$topdir\_embed.css",
                   13222:                          "$topdir/$topdir\_First_Frame.png",
                   13223:                          "$topdir/$topdir\_player.html",
                   13224:                          "$topdir/$topdir\_Thumbnails.png",
                   13225:                          "$topdir/playerProductInstall.swf",
                   13226:                          "$topdir/scripts/",
                   13227:                          "$topdir/scripts/config_xml.js",
                   13228:                          "$topdir/scripts/handlebars.js",
                   13229:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   13230:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   13231:                          "$topdir/scripts/modernizr.js",
                   13232:                          "$topdir/scripts/player-min.js",
                   13233:                          "$topdir/scripts/swfobject.js",
                   13234:                          "$topdir/skins/",
                   13235:                          "$topdir/skins/configuration_express.xml",
                   13236:                          "$topdir/skins/express_show/",
                   13237:                          "$topdir/skins/express_show/player-min.css",
                   13238:                          "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81  raeburn  13239:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   13240:                          "$topdir/$topdir.mp4",
                   13241:                          "$topdir/$topdir\_config.xml",
                   13242:                          "$topdir/$topdir\_controller.swf",
                   13243:                          "$topdir/$topdir\_embed.css",
                   13244:                          "$topdir/$topdir\_First_Frame.png",
                   13245:                          "$topdir/$topdir\_player.html",
                   13246:                          "$topdir/$topdir\_Thumbnails.png",
                   13247:                          "$topdir/playerProductInstall.swf",
                   13248:                          "$topdir/scripts/",
                   13249:                          "$topdir/scripts/config_xml.js",
                   13250:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   13251:                          "$topdir/skins/",
                   13252:                          "$topdir/skins/configuration_express.xml",
                   13253:                          "$topdir/skins/express_show/",
                   13254:                          "$topdir/skins/express_show/spritesheet.min.css",
                   13255:                          "$topdir/skins/express_show/spritesheet.png",
                   13256:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59  raeburn  13257:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  13258:         if (@diffs == 0) {
1.1075.2.59  raeburn  13259:             $is_camtasia = 6;
                   13260:         } else {
1.1075.2.81  raeburn  13261:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59  raeburn  13262:             if (@diffs == 0) {
                   13263:                 $is_camtasia = 8;
1.1075.2.81  raeburn  13264:             } else {
                   13265:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   13266:                 if (@diffs == 0) {
                   13267:                     $is_camtasia = 8;
                   13268:                 }
1.1075.2.59  raeburn  13269:             }
1.1067    raeburn  13270:         }
                   13271:     }
                   13272:     my $output;
                   13273:     if ($is_camtasia) {
                   13274:         $output = <<"ENDCAM";
                   13275: <script type="text/javascript" language="Javascript">
                   13276: // <![CDATA[
                   13277: 
                   13278: function camtasiaToggle() {
                   13279:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   13280:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  13281:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  13282:                 document.getElementById('camtasia_titles').style.display='block';
                   13283:             } else {
                   13284:                 document.getElementById('camtasia_titles').style.display='none';
                   13285:             }
                   13286:         }
                   13287:     }
                   13288:     return;
                   13289: }
                   13290: 
                   13291: // ]]>
                   13292: </script>
                   13293: <p>$lt{'camt'}</p>
                   13294: ENDCAM
1.1065    raeburn  13295:     } else {
1.1067    raeburn  13296:         $output = '<p>'.$lt{'this'};
                   13297:         if ($info eq '') {
                   13298:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   13299:         } else {
                   13300:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   13301:                        '<div><pre>'.$info.'</pre></div>';
                   13302:         }
1.1065    raeburn  13303:     }
1.1067    raeburn  13304:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  13305:     my $duplicates;
                   13306:     my $num = 0;
                   13307:     if (ref($dirlist) eq 'ARRAY') {
                   13308:         foreach my $item (@{$dirlist}) {
                   13309:             if (ref($item) eq 'ARRAY') {
                   13310:                 if (exists($toplevel{$item->[0]})) {
                   13311:                     $duplicates .= 
                   13312:                         &start_data_table_row().
                   13313:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   13314:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   13315:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   13316:                         'value="1" />'.&mt('Yes').'</label>'.
                   13317:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   13318:                         '<td>'.$item->[0].'</td>';
                   13319:                     if ($item->[2]) {
                   13320:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   13321:                     } else {
                   13322:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   13323:                     }
                   13324:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   13325:                                    '<td>'.
                   13326:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   13327:                                    '</td>'.
                   13328:                                    &end_data_table_row();
                   13329:                     $num ++;
                   13330:                 }
                   13331:             }
                   13332:         }
                   13333:     }
                   13334:     my $itemcount;
                   13335:     if (@paths > 0) {
                   13336:         $itemcount = scalar(@paths);
                   13337:     } else {
                   13338:         $itemcount = 1;
                   13339:     }
1.1067    raeburn  13340:     if ($is_camtasia) {
                   13341:         $output .= $lt{'auto'}.'<br />'.
                   13342:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  13343:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  13344:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   13345:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   13346:                    $lt{'no'}.'</label></span><br />'.
                   13347:                    '<div id="camtasia_titles" style="display:block">'.
                   13348:                    &Apache::lonhtmlcommon::start_pick_box().
                   13349:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   13350:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   13351:                    &Apache::lonhtmlcommon::row_closure().
                   13352:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   13353:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   13354:                    &Apache::lonhtmlcommon::row_closure(1).
                   13355:                    &Apache::lonhtmlcommon::end_pick_box().
                   13356:                    '</div>';
                   13357:     }
1.1065    raeburn  13358:     $output .= 
                   13359:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  13360:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   13361:         "\n";
1.1065    raeburn  13362:     if ($duplicates ne '') {
                   13363:         $output .= '<p><span class="LC_warning">'.
                   13364:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   13365:                    &start_data_table().
                   13366:                    &start_data_table_header_row().
                   13367:                    '<th>'.&mt('Overwrite?').'</th>'.
                   13368:                    '<th>'.&mt('Name').'</th>'.
                   13369:                    '<th>'.&mt('Type').'</th>'.
                   13370:                    '<th>'.&mt('Size').'</th>'.
                   13371:                    '<th>'.&mt('Last modified').'</th>'.
                   13372:                    &end_data_table_header_row().
                   13373:                    $duplicates.
                   13374:                    &end_data_table().
                   13375:                    '</p>';
                   13376:     }
1.1067    raeburn  13377:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  13378:     if (ref($hiddenelements) eq 'HASH') {
                   13379:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   13380:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   13381:         }
                   13382:     }
                   13383:     $output .= <<"END";
1.1067    raeburn  13384: <br />
1.1053    raeburn  13385: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   13386: </form>
                   13387: $noextract
                   13388: END
                   13389:     return $output;
                   13390: }
                   13391: 
1.1065    raeburn  13392: sub decompression_utility {
                   13393:     my ($program) = @_;
                   13394:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   13395:     my $location;
                   13396:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   13397:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   13398:                          '/usr/sbin/') {
                   13399:             if (-x $dir.$program) {
                   13400:                 $location = $dir.$program;
                   13401:                 last;
                   13402:             }
                   13403:         }
                   13404:     }
                   13405:     return $location;
                   13406: }
                   13407: 
                   13408: sub list_archive_contents {
                   13409:     my ($file,$pathsref) = @_;
                   13410:     my (@cmd,$output);
                   13411:     my $needsregexp;
                   13412:     if ($file =~ /\.zip$/) {
                   13413:         @cmd = (&decompression_utility('unzip'),"-l");
                   13414:         $needsregexp = 1;
                   13415:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   13416:              ($file =~ /\.tgz$/)) {
                   13417:         @cmd = (&decompression_utility('tar'),"-ztf");
                   13418:     } elsif ($file =~ /\.tar\.bz2$/) {
                   13419:         @cmd = (&decompression_utility('tar'),"-jtf");
                   13420:     } elsif ($file =~ m|\.tar$|) {
                   13421:         @cmd = (&decompression_utility('tar'),"-tf");
                   13422:     }
                   13423:     if (@cmd) {
                   13424:         undef($!);
                   13425:         undef($@);
                   13426:         if (open(my $fh,"-|", @cmd, $file)) {
                   13427:             while (my $line = <$fh>) {
                   13428:                 $output .= $line;
                   13429:                 chomp($line);
                   13430:                 my $item;
                   13431:                 if ($needsregexp) {
                   13432:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   13433:                 } else {
                   13434:                     $item = $line;
                   13435:                 }
                   13436:                 if ($item ne '') {
                   13437:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   13438:                         push(@{$pathsref},$item);
                   13439:                     } 
                   13440:                 }
                   13441:             }
                   13442:             close($fh);
                   13443:         }
                   13444:     }
                   13445:     return $output;
                   13446: }
                   13447: 
1.1053    raeburn  13448: sub decompress_uploaded_file {
                   13449:     my ($file,$dir) = @_;
                   13450:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   13451:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   13452:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   13453:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   13454:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   13455:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   13456:     my $decompressed = $env{'cgi.decompressed'};
                   13457:     &Apache::lonnet::delenv('cgi.file');
                   13458:     &Apache::lonnet::delenv('cgi.dir');
                   13459:     &Apache::lonnet::delenv('cgi.decompressed');
                   13460:     return ($decompressed,$result);
                   13461: }
                   13462: 
1.1055    raeburn  13463: sub process_decompression {
                   13464:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1075.2.128  raeburn  13465:     unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
                   13466:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13467:                &mt('Unexpected file path.').'</p>'."\n";
                   13468:     }
                   13469:     unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
                   13470:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13471:                &mt('Unexpected course context.').'</p>'."\n";
                   13472:     }
                   13473:     unless ($file eq &Apache::lonnet::clean_filename($file)) {
                   13474:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13475:                &mt('Filename contained unexpected characters.').'</p>'."\n";
                   13476:     }
1.1055    raeburn  13477:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  13478:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  13479:         $error = &mt('Filename not a supported archive file type.').
                   13480:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  13481:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   13482:     } else {
                   13483:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   13484:         if ($docuhome eq 'no_host') {
                   13485:             $error = &mt('Could not determine home server for course.');
                   13486:         } else {
                   13487:             my @ids=&Apache::lonnet::current_machine_ids();
                   13488:             my $currdir = "$dir_root/$destination";
                   13489:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   13490:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   13491:                        "$dir_root/$destination";
                   13492:             } else {
                   13493:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   13494:                        "$dir_root/$docudom/$docuname/$destination";
                   13495:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   13496:                     $error = &mt('Archive file not found.');
                   13497:                 }
                   13498:             }
1.1065    raeburn  13499:             my (@to_overwrite,@to_skip);
                   13500:             if ($env{'form.archive_overwrite_total'} > 0) {
                   13501:                 my $total = $env{'form.archive_overwrite_total'};
                   13502:                 for (my $i=0; $i<$total; $i++) {
                   13503:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   13504:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   13505:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   13506:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   13507:                     }
                   13508:                 }
                   13509:             }
                   13510:             my $numskip = scalar(@to_skip);
1.1075.2.128  raeburn  13511:             my $numoverwrite = scalar(@to_overwrite);
                   13512:             if (($numskip) && (!$numoverwrite)) {
1.1065    raeburn  13513:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   13514:             } elsif ($dir eq '') {
1.1055    raeburn  13515:                 $error = &mt('Directory containing archive file unavailable.');
                   13516:             } elsif (!$error) {
1.1065    raeburn  13517:                 my ($decompressed,$display);
1.1075.2.128  raeburn  13518:                 if (($numskip) || ($numoverwrite)) {
1.1065    raeburn  13519:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   13520:                     mkdir("$dir/$tempdir",0755);
1.1075.2.128  raeburn  13521:                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                   13522:                         ($decompressed,$display) =
                   13523:                             &decompress_uploaded_file($file,"$dir/$tempdir");
                   13524:                         foreach my $item (@to_skip) {
                   13525:                             if (($item ne '') && ($item !~ /\.\./)) {
                   13526:                                 if (-f "$dir/$tempdir/$item") {
                   13527:                                     unlink("$dir/$tempdir/$item");
                   13528:                                 } elsif (-d "$dir/$tempdir/$item") {
                   13529:                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
                   13530:                                 }
                   13531:                             }
                   13532:                         }
                   13533:                         foreach my $item (@to_overwrite) {
                   13534:                             if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
                   13535:                                 if (($item ne '') && ($item !~ /\.\./)) {
                   13536:                                     if (-f "$dir/$item") {
                   13537:                                         unlink("$dir/$item");
                   13538:                                     } elsif (-d "$dir/$item") {
                   13539:                                         &File::Path::remove_tree("$dir/$item",{ safe => 1 });
                   13540:                                     }
                   13541:                                     &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
                   13542:                                 }
1.1065    raeburn  13543:                             }
                   13544:                         }
1.1075.2.128  raeburn  13545:                         if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
                   13546:                             &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
                   13547:                         }
1.1065    raeburn  13548:                     }
                   13549:                 } else {
                   13550:                     ($decompressed,$display) = 
                   13551:                         &decompress_uploaded_file($file,$dir);
                   13552:                 }
1.1055    raeburn  13553:                 if ($decompressed eq 'ok') {
1.1065    raeburn  13554:                     $output = '<p class="LC_info">'.
                   13555:                               &mt('Files extracted successfully from archive.').
                   13556:                               '</p>'."\n";
1.1055    raeburn  13557:                     my ($warning,$result,@contents);
                   13558:                     my ($newdirlistref,$newlisterror) =
                   13559:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   13560:                                                  $docuname,1);
                   13561:                     my (%is_dir,%changes,@newitems);
                   13562:                     my $dirptr = 16384;
1.1065    raeburn  13563:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  13564:                         foreach my $dir_line (@{$newdirlistref}) {
                   13565:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1075.2.128  raeburn  13566:                             unless (($item =~ /^\.+$/) || ($item eq $file)) { 
1.1055    raeburn  13567:                                 push(@newitems,$item);
                   13568:                                 if ($dirptr&$testdir) {
                   13569:                                     $is_dir{$item} = 1;
                   13570:                                 }
                   13571:                                 $changes{$item} = 1;
                   13572:                             }
                   13573:                         }
                   13574:                     }
                   13575:                     if (keys(%changes) > 0) {
                   13576:                         foreach my $item (sort(@newitems)) {
                   13577:                             if ($changes{$item}) {
                   13578:                                 push(@contents,$item);
                   13579:                             }
                   13580:                         }
                   13581:                     }
                   13582:                     if (@contents > 0) {
1.1067    raeburn  13583:                         my $wantform;
                   13584:                         unless ($env{'form.autoextract_camtasia'}) {
                   13585:                             $wantform = 1;
                   13586:                         }
1.1056    raeburn  13587:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  13588:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   13589:                                                                 $currdir,\%is_dir,
                   13590:                                                                 \%children,\%parent,
1.1056    raeburn  13591:                                                                 \@contents,\%dirorder,
                   13592:                                                                 \%titles,$wantform);
1.1055    raeburn  13593:                         if ($datatable ne '') {
                   13594:                             $output .= &archive_options_form('decompressed',$datatable,
                   13595:                                                              $count,$hiddenelem);
1.1065    raeburn  13596:                             my $startcount = 6;
1.1055    raeburn  13597:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  13598:                                                            \%titles,\%children);
1.1055    raeburn  13599:                         }
1.1067    raeburn  13600:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  13601:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  13602:                             my %displayed;
                   13603:                             my $total = 1;
                   13604:                             $env{'form.archive_directory'} = [];
                   13605:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   13606:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   13607:                                 $path =~ s{/$}{};
                   13608:                                 my $item;
                   13609:                                 if ($path ne '') {
                   13610:                                     $item = "$path/$titles{$i}";
                   13611:                                 } else {
                   13612:                                     $item = $titles{$i};
                   13613:                                 }
                   13614:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   13615:                                 if ($item eq $contents[0]) {
                   13616:                                     push(@{$env{'form.archive_directory'}},$i);
                   13617:                                     $env{'form.archive_'.$i} = 'display';
                   13618:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   13619:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  13620:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   13621:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  13622:                                     $env{'form.archive_'.$i} = 'display';
                   13623:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   13624:                                     $displayed{'web'} = $i;
                   13625:                                 } else {
1.1075.2.59  raeburn  13626:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   13627:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   13628:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  13629:                                         push(@{$env{'form.archive_directory'}},$i);
                   13630:                                     }
                   13631:                                     $env{'form.archive_'.$i} = 'dependency';
                   13632:                                 }
                   13633:                                 $total ++;
                   13634:                             }
                   13635:                             for (my $i=1; $i<$total; $i++) {
                   13636:                                 next if ($i == $displayed{'web'});
                   13637:                                 next if ($i == $displayed{'folder'});
                   13638:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   13639:                             }
                   13640:                             $env{'form.phase'} = 'decompress_cleanup';
                   13641:                             $env{'form.archivedelete'} = 1;
                   13642:                             $env{'form.archive_count'} = $total-1;
                   13643:                             $output .=
                   13644:                                 &process_extracted_files('coursedocs',$docudom,
                   13645:                                                          $docuname,$destination,
                   13646:                                                          $dir_root,$hiddenelem);
                   13647:                         }
1.1055    raeburn  13648:                     } else {
                   13649:                         $warning = &mt('No new items extracted from archive file.');
                   13650:                     }
                   13651:                 } else {
                   13652:                     $output = $display;
                   13653:                     $error = &mt('An error occurred during extraction from the archive file.');
                   13654:                 }
                   13655:             }
                   13656:         }
                   13657:     }
                   13658:     if ($error) {
                   13659:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13660:                    $error.'</p>'."\n";
                   13661:     }
                   13662:     if ($warning) {
                   13663:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   13664:     }
                   13665:     return $output;
                   13666: }
                   13667: 
                   13668: sub get_extracted {
1.1056    raeburn  13669:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   13670:         $titles,$wantform) = @_;
1.1055    raeburn  13671:     my $count = 0;
                   13672:     my $depth = 0;
                   13673:     my $datatable;
1.1056    raeburn  13674:     my @hierarchy;
1.1055    raeburn  13675:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  13676:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   13677:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  13678:     foreach my $item (@{$contents}) {
                   13679:         $count ++;
1.1056    raeburn  13680:         @{$dirorder->{$count}} = @hierarchy;
                   13681:         $titles->{$count} = $item;
1.1055    raeburn  13682:         &archive_hierarchy($depth,$count,$parent,$children);
                   13683:         if ($wantform) {
                   13684:             $datatable .= &archive_row($is_dir->{$item},$item,
                   13685:                                        $currdir,$depth,$count);
                   13686:         }
                   13687:         if ($is_dir->{$item}) {
                   13688:             $depth ++;
1.1056    raeburn  13689:             push(@hierarchy,$count);
                   13690:             $parent->{$depth} = $count;
1.1055    raeburn  13691:             $datatable .=
                   13692:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  13693:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   13694:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  13695:             $depth --;
1.1056    raeburn  13696:             pop(@hierarchy);
1.1055    raeburn  13697:         }
                   13698:     }
                   13699:     return ($count,$datatable);
                   13700: }
                   13701: 
                   13702: sub recurse_extracted_archive {
1.1056    raeburn  13703:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   13704:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  13705:     my $result='';
1.1056    raeburn  13706:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   13707:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   13708:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  13709:         return $result;
                   13710:     }
                   13711:     my $dirptr = 16384;
                   13712:     my ($newdirlistref,$newlisterror) =
                   13713:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   13714:     if (ref($newdirlistref) eq 'ARRAY') {
                   13715:         foreach my $dir_line (@{$newdirlistref}) {
                   13716:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   13717:             unless ($item =~ /^\.+$/) {
                   13718:                 $$count ++;
1.1056    raeburn  13719:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   13720:                 $titles->{$$count} = $item;
1.1055    raeburn  13721:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  13722: 
1.1055    raeburn  13723:                 my $is_dir;
                   13724:                 if ($dirptr&$testdir) {
                   13725:                     $is_dir = 1;
                   13726:                 }
                   13727:                 if ($wantform) {
                   13728:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   13729:                 }
                   13730:                 if ($is_dir) {
                   13731:                     $$depth ++;
1.1056    raeburn  13732:                     push(@{$hierarchy},$$count);
                   13733:                     $parent->{$$depth} = $$count;
1.1055    raeburn  13734:                     $result .=
                   13735:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   13736:                                                    $docuname,$depth,$count,
1.1056    raeburn  13737:                                                    $hierarchy,$dirorder,$children,
                   13738:                                                    $parent,$titles,$wantform);
1.1055    raeburn  13739:                     $$depth --;
1.1056    raeburn  13740:                     pop(@{$hierarchy});
1.1055    raeburn  13741:                 }
                   13742:             }
                   13743:         }
                   13744:     }
                   13745:     return $result;
                   13746: }
                   13747: 
                   13748: sub archive_hierarchy {
                   13749:     my ($depth,$count,$parent,$children) =@_;
                   13750:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   13751:         if (exists($parent->{$depth})) {
                   13752:              $children->{$parent->{$depth}} .= $count.':';
                   13753:         }
                   13754:     }
                   13755:     return;
                   13756: }
                   13757: 
                   13758: sub archive_row {
                   13759:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   13760:     my ($name) = ($item =~ m{([^/]+)$});
                   13761:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  13762:                                        'display'    => 'Add as file',
1.1055    raeburn  13763:                                        'dependency' => 'Include as dependency',
                   13764:                                        'discard'    => 'Discard',
                   13765:                                       );
                   13766:     if ($is_dir) {
1.1059    raeburn  13767:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  13768:     }
1.1056    raeburn  13769:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   13770:     my $offset = 0;
1.1055    raeburn  13771:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  13772:         $offset ++;
1.1065    raeburn  13773:         if ($action ne 'display') {
                   13774:             $offset ++;
                   13775:         }  
1.1055    raeburn  13776:         $output .= '<td><span class="LC_nobreak">'.
                   13777:                    '<label><input type="radio" name="archive_'.$count.
                   13778:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   13779:         my $text = $choices{$action};
                   13780:         if ($is_dir) {
                   13781:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   13782:             if ($action eq 'display') {
1.1059    raeburn  13783:                 $text = &mt('Add as folder');
1.1055    raeburn  13784:             }
1.1056    raeburn  13785:         } else {
                   13786:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   13787: 
                   13788:         }
                   13789:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   13790:         if ($action eq 'dependency') {
                   13791:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   13792:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   13793:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   13794:                        '<option value=""></option>'."\n".
                   13795:                        '</select>'."\n".
                   13796:                        '</div>';
1.1059    raeburn  13797:         } elsif ($action eq 'display') {
                   13798:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   13799:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   13800:                        '</div>';
1.1055    raeburn  13801:         }
1.1056    raeburn  13802:         $output .= '</td>';
1.1055    raeburn  13803:     }
                   13804:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   13805:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   13806:     for (my $i=0; $i<$depth; $i++) {
                   13807:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   13808:     }
                   13809:     if ($is_dir) {
                   13810:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   13811:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   13812:     } else {
                   13813:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   13814:     }
                   13815:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   13816:                &end_data_table_row();
                   13817:     return $output;
                   13818: }
                   13819: 
                   13820: sub archive_options_form {
1.1065    raeburn  13821:     my ($form,$display,$count,$hiddenelem) = @_;
                   13822:     my %lt = &Apache::lonlocal::texthash(
                   13823:                perm => 'Permanently remove archive file?',
                   13824:                hows => 'How should each extracted item be incorporated in the course?',
                   13825:                cont => 'Content actions for all',
                   13826:                addf => 'Add as folder/file',
                   13827:                incd => 'Include as dependency for a displayed file',
                   13828:                disc => 'Discard',
                   13829:                no   => 'No',
                   13830:                yes  => 'Yes',
                   13831:                save => 'Save',
                   13832:     );
                   13833:     my $output = <<"END";
                   13834: <form name="$form" method="post" action="">
                   13835: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   13836: <label>
                   13837:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   13838: </label>
                   13839: &nbsp;
                   13840: <label>
                   13841:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   13842: </span>
                   13843: </p>
                   13844: <input type="hidden" name="phase" value="decompress_cleanup" />
                   13845: <br />$lt{'hows'}
                   13846: <div class="LC_columnSection">
                   13847:   <fieldset>
                   13848:     <legend>$lt{'cont'}</legend>
                   13849:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   13850:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   13851:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   13852:   </fieldset>
                   13853: </div>
                   13854: END
                   13855:     return $output.
1.1055    raeburn  13856:            &start_data_table()."\n".
1.1065    raeburn  13857:            $display."\n".
1.1055    raeburn  13858:            &end_data_table()."\n".
                   13859:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   13860:            $hiddenelem.
1.1065    raeburn  13861:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  13862:            '</form>';
                   13863: }
                   13864: 
                   13865: sub archive_javascript {
1.1056    raeburn  13866:     my ($startcount,$numitems,$titles,$children) = @_;
                   13867:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  13868:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  13869:     my $scripttag = <<START;
                   13870: <script type="text/javascript">
                   13871: // <![CDATA[
                   13872: 
                   13873: function checkAll(form,prefix) {
                   13874:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   13875:     for (var i=0; i < form.elements.length; i++) {
                   13876:         var id = form.elements[i].id;
                   13877:         if ((id != '') && (id != undefined)) {
                   13878:             if (idstr.test(id)) {
                   13879:                 if (form.elements[i].type == 'radio') {
                   13880:                     form.elements[i].checked = true;
1.1056    raeburn  13881:                     var nostart = i-$startcount;
1.1059    raeburn  13882:                     var offset = nostart%7;
                   13883:                     var count = (nostart-offset)/7;    
1.1056    raeburn  13884:                     dependencyCheck(form,count,offset);
1.1055    raeburn  13885:                 }
                   13886:             }
                   13887:         }
                   13888:     }
                   13889: }
                   13890: 
                   13891: function propagateCheck(form,count) {
                   13892:     if (count > 0) {
1.1059    raeburn  13893:         var startelement = $startcount + ((count-1) * 7);
                   13894:         for (var j=1; j<6; j++) {
                   13895:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  13896:                 var item = startelement + j; 
                   13897:                 if (form.elements[item].type == 'radio') {
                   13898:                     if (form.elements[item].checked) {
                   13899:                         containerCheck(form,count,j);
                   13900:                         break;
                   13901:                     }
1.1055    raeburn  13902:                 }
                   13903:             }
                   13904:         }
                   13905:     }
                   13906: }
                   13907: 
                   13908: numitems = $numitems
1.1056    raeburn  13909: var titles = new Array(numitems);
                   13910: var parents = new Array(numitems);
1.1055    raeburn  13911: for (var i=0; i<numitems; i++) {
1.1056    raeburn  13912:     parents[i] = new Array;
1.1055    raeburn  13913: }
1.1059    raeburn  13914: var maintitle = '$maintitle';
1.1055    raeburn  13915: 
                   13916: START
                   13917: 
1.1056    raeburn  13918:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   13919:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  13920:         for (my $i=0; $i<@contents; $i ++) {
                   13921:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   13922:         }
                   13923:     }
                   13924: 
1.1056    raeburn  13925:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   13926:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   13927:     }
                   13928: 
1.1055    raeburn  13929:     $scripttag .= <<END;
                   13930: 
                   13931: function containerCheck(form,count,offset) {
                   13932:     if (count > 0) {
1.1056    raeburn  13933:         dependencyCheck(form,count,offset);
1.1059    raeburn  13934:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  13935:         form.elements[item].checked = true;
                   13936:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   13937:             if (parents[count].length > 0) {
                   13938:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  13939:                     containerCheck(form,parents[count][j],offset);
                   13940:                 }
                   13941:             }
                   13942:         }
                   13943:     }
                   13944: }
                   13945: 
                   13946: function dependencyCheck(form,count,offset) {
                   13947:     if (count > 0) {
1.1059    raeburn  13948:         var chosen = (offset+$startcount)+7*(count-1);
                   13949:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  13950:         var currtype = form.elements[depitem].type;
                   13951:         if (form.elements[chosen].value == 'dependency') {
                   13952:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   13953:             form.elements[depitem].options.length = 0;
                   13954:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  13955:             for (var i=1; i<=numitems; i++) {
                   13956:                 if (i == count) {
                   13957:                     continue;
                   13958:                 }
1.1059    raeburn  13959:                 var startelement = $startcount + (i-1) * 7;
                   13960:                 for (var j=1; j<6; j++) {
                   13961:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  13962:                         var item = startelement + j;
                   13963:                         if (form.elements[item].type == 'radio') {
                   13964:                             if (form.elements[item].checked) {
                   13965:                                 if (form.elements[item].value == 'display') {
                   13966:                                     var n = form.elements[depitem].options.length;
                   13967:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   13968:                                 }
                   13969:                             }
                   13970:                         }
                   13971:                     }
                   13972:                 }
                   13973:             }
                   13974:         } else {
                   13975:             document.getElementById('arc_depon_'+count).style.display='none';
                   13976:             form.elements[depitem].options.length = 0;
                   13977:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   13978:         }
1.1059    raeburn  13979:         titleCheck(form,count,offset);
1.1056    raeburn  13980:     }
                   13981: }
                   13982: 
                   13983: function propagateSelect(form,count,offset) {
                   13984:     if (count > 0) {
1.1065    raeburn  13985:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  13986:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   13987:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   13988:             if (parents[count].length > 0) {
                   13989:                 for (var j=0; j<parents[count].length; j++) {
                   13990:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  13991:                 }
                   13992:             }
                   13993:         }
                   13994:     }
                   13995: }
1.1056    raeburn  13996: 
                   13997: function containerSelect(form,count,offset,picked) {
                   13998:     if (count > 0) {
1.1065    raeburn  13999:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  14000:         if (form.elements[item].type == 'radio') {
                   14001:             if (form.elements[item].value == 'dependency') {
                   14002:                 if (form.elements[item+1].type == 'select-one') {
                   14003:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   14004:                         if (form.elements[item+1].options[i].value == picked) {
                   14005:                             form.elements[item+1].selectedIndex = i;
                   14006:                             break;
                   14007:                         }
                   14008:                     }
                   14009:                 }
                   14010:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   14011:                     if (parents[count].length > 0) {
                   14012:                         for (var j=0; j<parents[count].length; j++) {
                   14013:                             containerSelect(form,parents[count][j],offset,picked);
                   14014:                         }
                   14015:                     }
                   14016:                 }
                   14017:             }
                   14018:         }
                   14019:     }
                   14020: }
                   14021: 
1.1059    raeburn  14022: function titleCheck(form,count,offset) {
                   14023:     if (count > 0) {
                   14024:         var chosen = (offset+$startcount)+7*(count-1);
                   14025:         var depitem = $startcount + ((count-1) * 7) + 2;
                   14026:         var currtype = form.elements[depitem].type;
                   14027:         if (form.elements[chosen].value == 'display') {
                   14028:             document.getElementById('arc_title_'+count).style.display='block';
                   14029:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   14030:                 document.getElementById('archive_title_'+count).value=maintitle;
                   14031:             }
                   14032:         } else {
                   14033:             document.getElementById('arc_title_'+count).style.display='none';
                   14034:             if (currtype == 'text') { 
                   14035:                 document.getElementById('archive_title_'+count).value='';
                   14036:             }
                   14037:         }
                   14038:     }
                   14039:     return;
                   14040: }
                   14041: 
1.1055    raeburn  14042: // ]]>
                   14043: </script>
                   14044: END
                   14045:     return $scripttag;
                   14046: }
                   14047: 
                   14048: sub process_extracted_files {
1.1067    raeburn  14049:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  14050:     my $numitems = $env{'form.archive_count'};
1.1075.2.128  raeburn  14051:     return if ((!$numitems) || ($numitems =~ /\D/));
1.1055    raeburn  14052:     my @ids=&Apache::lonnet::current_machine_ids();
                   14053:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  14054:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  14055:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   14056:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   14057:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   14058:         $pathtocheck = "$dir_root/$destination";
                   14059:         $dir = $dir_root;
                   14060:         $ishome = 1;
                   14061:     } else {
                   14062:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   14063:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1075.2.128  raeburn  14064:         $dir = "$dir_root/$docudom/$docuname";
1.1055    raeburn  14065:     }
                   14066:     my $currdir = "$dir_root/$destination";
                   14067:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   14068:     if ($env{'form.folderpath'}) {
                   14069:         my @items = split('&',$env{'form.folderpath'});
                   14070:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  14071:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   14072:             $containers{'0'}='page';
                   14073:         } else {
                   14074:             $containers{'0'}='sequence';
                   14075:         }
1.1055    raeburn  14076:     }
                   14077:     my @archdirs = &get_env_multiple('form.archive_directory');
                   14078:     if ($numitems) {
                   14079:         for (my $i=1; $i<=$numitems; $i++) {
                   14080:             my $path = $env{'form.archive_content_'.$i};
                   14081:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   14082:                 my $item = $1;
                   14083:                 $toplevelitems{$item} = $i;
                   14084:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   14085:                     $is_dir{$item} = 1;
                   14086:                 }
                   14087:             }
                   14088:         }
                   14089:     }
1.1067    raeburn  14090:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  14091:     if (keys(%toplevelitems) > 0) {
                   14092:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  14093:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   14094:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  14095:     }
1.1066    raeburn  14096:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  14097:     if ($numitems) {
                   14098:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  14099:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  14100:             my $path = $env{'form.archive_content_'.$i};
                   14101:             if ($path =~ /^\Q$pathtocheck\E/) {
                   14102:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   14103:                     if ($prefix ne '' && $path ne '') {
                   14104:                         if (-e $prefix.$path) {
1.1066    raeburn  14105:                             if ((@archdirs > 0) && 
                   14106:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   14107:                                 $todeletedir{$prefix.$path} = 1;
                   14108:                             } else {
                   14109:                                 $todelete{$prefix.$path} = 1;
                   14110:                             }
1.1055    raeburn  14111:                         }
                   14112:                     }
                   14113:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  14114:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  14115:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  14116:                     $docstitle = $env{'form.archive_title_'.$i};
                   14117:                     if ($docstitle eq '') {
                   14118:                         $docstitle = $title;
                   14119:                     }
1.1055    raeburn  14120:                     $outer = 0;
1.1056    raeburn  14121:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   14122:                         if (@{$dirorder{$i}} > 0) {
                   14123:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  14124:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   14125:                                     $outer = $item;
                   14126:                                     last;
                   14127:                                 }
                   14128:                             }
                   14129:                         }
                   14130:                     }
                   14131:                     my ($errtext,$fatal) = 
                   14132:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   14133:                                                '/'.$folders{$outer}.'.'.
                   14134:                                                $containers{$outer});
                   14135:                     next if ($fatal);
                   14136:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   14137:                         if ($context eq 'coursedocs') {
1.1056    raeburn  14138:                             $mapinner{$i} = time;
1.1055    raeburn  14139:                             $folders{$i} = 'default_'.$mapinner{$i};
                   14140:                             $containers{$i} = 'sequence';
                   14141:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   14142:                                       $folders{$i}.'.'.$containers{$i};
                   14143:                             my $newidx = &LONCAPA::map::getresidx();
                   14144:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  14145:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  14146:                             push(@LONCAPA::map::order,$newidx);
                   14147:                             my ($outtext,$errtext) =
                   14148:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   14149:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  14150:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  14151:                             $newseqid{$i} = $newidx;
1.1067    raeburn  14152:                             unless ($errtext) {
1.1075.2.128  raeburn  14153:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',
                   14154:                                                        &HTML::Entities::encode($docstitle,'<>&"'))..
                   14155:                                             '</li>'."\n";
1.1067    raeburn  14156:                             }
1.1055    raeburn  14157:                         }
                   14158:                     } else {
                   14159:                         if ($context eq 'coursedocs') {
                   14160:                             my $newidx=&LONCAPA::map::getresidx();
                   14161:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   14162:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   14163:                                       $title;
1.1075.2.161.  .13(raeb 14164:-23):                             if (($outer !~ /\D/) &&
                   14165:-23):                                 (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
                   14166:-23):                                 ($newidx !~ /\D/)) {
1.1075.2.128  raeburn  14167:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   14168:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
1.1067    raeburn  14169:                                 }
1.1075.2.128  raeburn  14170:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   14171:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   14172:                                 }
                   14173:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   14174:                                     if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
                   14175:                                         $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                   14176:                                         unless ($ishome) {
                   14177:                                             my $fetch = "$newdest{$i}/$title";
                   14178:                                             $fetch =~ s/^\Q$prefix$dir\E//;
                   14179:                                             $prompttofetch{$fetch} = 1;
                   14180:                                         }
                   14181:                                    }
                   14182:                                 }
                   14183:                                 $LONCAPA::map::resources[$newidx]=
                   14184:                                     $docstitle.':'.$url.':false:normal:res';
                   14185:                                 push(@LONCAPA::map::order, $newidx);
                   14186:                                 my ($outtext,$errtext)=
                   14187:                                     &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   14188:                                                             $docuname.'/'.$folders{$outer}.
                   14189:                                                             '.'.$containers{$outer},1,1);
                   14190:                                 unless ($errtext) {
                   14191:                                     if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   14192:                                         $result .= '<li>'.&mt('File: [_1] added to course',
                   14193:                                                               &HTML::Entities::encode($docstitle,'<>&"')).
                   14194:                                                    '</li>'."\n";
                   14195:                                     }
1.1067    raeburn  14196:                                 }
1.1075.2.128  raeburn  14197:                             } else {
                   14198:                                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   14199:                                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1067    raeburn  14200:                             }
1.1055    raeburn  14201:                         }
                   14202:                     }
1.1075.2.11  raeburn  14203:                 }
                   14204:             } else {
1.1075.2.128  raeburn  14205:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   14206:                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1075.2.11  raeburn  14207:             }
                   14208:         }
                   14209:         for (my $i=1; $i<=$numitems; $i++) {
                   14210:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   14211:             my $path = $env{'form.archive_content_'.$i};
                   14212:             if ($path =~ /^\Q$pathtocheck\E/) {
                   14213:                 my ($title) = ($path =~ m{/([^/]+)$});
                   14214:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   14215:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   14216:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   14217:                         my ($itemidx,$fullpath,$relpath);
                   14218:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   14219:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  14220:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  14221:                                 if ($dirorder{$i}->[$j] eq $container) {
                   14222:                                     $itemidx = $j;
1.1056    raeburn  14223:                                 }
                   14224:                             }
1.1075.2.11  raeburn  14225:                         }
                   14226:                         if ($itemidx eq '') {
                   14227:                             $itemidx =  0;
                   14228:                         }
                   14229:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   14230:                             if ($mapinner{$referrer{$i}}) {
                   14231:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   14232:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   14233:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   14234:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   14235:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14236:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14237:                                             if (!-e $fullpath) {
                   14238:                                                 mkdir($fullpath,0755);
1.1056    raeburn  14239:                                             }
                   14240:                                         }
1.1075.2.11  raeburn  14241:                                     } else {
                   14242:                                         last;
1.1056    raeburn  14243:                                     }
1.1075.2.11  raeburn  14244:                                 }
                   14245:                             }
                   14246:                         } elsif ($newdest{$referrer{$i}}) {
                   14247:                             $fullpath = $newdest{$referrer{$i}};
                   14248:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   14249:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   14250:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   14251:                                     last;
                   14252:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   14253:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   14254:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14255:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14256:                                         if (!-e $fullpath) {
                   14257:                                             mkdir($fullpath,0755);
1.1056    raeburn  14258:                                         }
                   14259:                                     }
1.1075.2.11  raeburn  14260:                                 } else {
                   14261:                                     last;
1.1056    raeburn  14262:                                 }
1.1075.2.11  raeburn  14263:                             }
                   14264:                         }
                   14265:                         if ($fullpath ne '') {
                   14266:                             if (-e "$prefix$path") {
1.1075.2.128  raeburn  14267:                                 unless (rename("$prefix$path","$fullpath/$title")) {
                   14268:                                      $warning .= &mt('Failed to rename dependency').'<br />';
                   14269:                                 }
1.1075.2.11  raeburn  14270:                             }
                   14271:                             if (-e "$fullpath/$title") {
                   14272:                                 my $showpath;
                   14273:                                 if ($relpath ne '') {
                   14274:                                     $showpath = "$relpath/$title";
                   14275:                                 } else {
                   14276:                                     $showpath = "/$title";
1.1056    raeburn  14277:                                 }
1.1075.2.128  raeburn  14278:                                 $result .= '<li>'.&mt('[_1] included as a dependency',
                   14279:                                                       &HTML::Entities::encode($showpath,'<>&"')).
                   14280:                                            '</li>'."\n";
                   14281:                                 unless ($ishome) {
                   14282:                                     my $fetch = "$fullpath/$title";
                   14283:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   14284:                                     $prompttofetch{$fetch} = 1;
                   14285:                                 }
1.1055    raeburn  14286:                             }
                   14287:                         }
                   14288:                     }
1.1075.2.11  raeburn  14289:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   14290:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1075.2.128  raeburn  14291:                                     &HTML::Entities::encode($path,'<>&"'),
                   14292:                                     &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
                   14293:                                 '<br />';
1.1055    raeburn  14294:                 }
                   14295:             } else {
1.1075.2.128  raeburn  14296:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   14297:                                 &HTML::Entities::encode($path)).'<br />';
1.1055    raeburn  14298:             }
                   14299:         }
                   14300:         if (keys(%todelete)) {
                   14301:             foreach my $key (keys(%todelete)) {
                   14302:                 unlink($key);
1.1066    raeburn  14303:             }
                   14304:         }
                   14305:         if (keys(%todeletedir)) {
                   14306:             foreach my $key (keys(%todeletedir)) {
                   14307:                 rmdir($key);
                   14308:             }
                   14309:         }
                   14310:         foreach my $dir (sort(keys(%is_dir))) {
                   14311:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   14312:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  14313:             }
                   14314:         }
1.1067    raeburn  14315:         if ($result ne '') {
                   14316:             $output .= '<ul>'."\n".
                   14317:                        $result."\n".
                   14318:                        '</ul>';
                   14319:         }
                   14320:         unless ($ishome) {
                   14321:             my $replicationfail;
                   14322:             foreach my $item (keys(%prompttofetch)) {
                   14323:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   14324:                 unless ($fetchresult eq 'ok') {
                   14325:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   14326:                 }
                   14327:             }
                   14328:             if ($replicationfail) {
                   14329:                 $output .= '<p class="LC_error">'.
                   14330:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   14331:                            $replicationfail.
                   14332:                            '</ul></p>';
                   14333:             }
                   14334:         }
1.1055    raeburn  14335:     } else {
                   14336:         $warning = &mt('No items found in archive.');
                   14337:     }
                   14338:     if ($error) {
                   14339:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   14340:                    $error.'</p>'."\n";
                   14341:     }
                   14342:     if ($warning) {
                   14343:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   14344:     }
                   14345:     return $output;
                   14346: }
                   14347: 
1.1066    raeburn  14348: sub cleanup_empty_dirs {
                   14349:     my ($path) = @_;
                   14350:     if (($path ne '') && (-d $path)) {
                   14351:         if (opendir(my $dirh,$path)) {
                   14352:             my @dircontents = grep(!/^\./,readdir($dirh));
                   14353:             my $numitems = 0;
                   14354:             foreach my $item (@dircontents) {
                   14355:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  14356:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  14357:                     if (-e "$path/$item") {
                   14358:                         $numitems ++;
                   14359:                     }
                   14360:                 } else {
                   14361:                     $numitems ++;
                   14362:                 }
                   14363:             }
                   14364:             if ($numitems == 0) {
                   14365:                 rmdir($path);
                   14366:             }
                   14367:             closedir($dirh);
                   14368:         }
                   14369:     }
                   14370:     return;
                   14371: }
                   14372: 
1.41      ng       14373: =pod
1.45      matthew  14374: 
1.1075.2.56  raeburn  14375: =item * &get_folder_hierarchy()
1.1068    raeburn  14376: 
                   14377: Provides hierarchy of names of folders/sub-folders containing the current
                   14378: item,
                   14379: 
                   14380: Inputs: 3
                   14381:      - $navmap - navmaps object
                   14382: 
                   14383:      - $map - url for map (either the trigger itself, or map containing
                   14384:                            the resource, which is the trigger).
                   14385: 
                   14386:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   14387: 
                   14388: Outputs: 1 @pathitems - array of folder/subfolder names.
                   14389: 
                   14390: =cut
                   14391: 
                   14392: sub get_folder_hierarchy {
                   14393:     my ($navmap,$map,$showitem) = @_;
                   14394:     my @pathitems;
                   14395:     if (ref($navmap)) {
                   14396:         my $mapres = $navmap->getResourceByUrl($map);
                   14397:         if (ref($mapres)) {
                   14398:             my $pcslist = $mapres->map_hierarchy();
                   14399:             if ($pcslist ne '') {
                   14400:                 my @pcs = split(/,/,$pcslist);
                   14401:                 foreach my $pc (@pcs) {
                   14402:                     if ($pc == 1) {
1.1075.2.38  raeburn  14403:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  14404:                     } else {
                   14405:                         my $res = $navmap->getByMapPc($pc);
                   14406:                         if (ref($res)) {
                   14407:                             my $title = $res->compTitle();
                   14408:                             $title =~ s/\W+/_/g;
                   14409:                             if ($title ne '') {
                   14410:                                 push(@pathitems,$title);
                   14411:                             }
                   14412:                         }
                   14413:                     }
                   14414:                 }
                   14415:             }
1.1071    raeburn  14416:             if ($showitem) {
                   14417:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  14418:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  14419:                 } else {
                   14420:                     my $maptitle = $mapres->compTitle();
                   14421:                     $maptitle =~ s/\W+/_/g;
                   14422:                     if ($maptitle ne '') {
                   14423:                         push(@pathitems,$maptitle);
                   14424:                     }
1.1068    raeburn  14425:                 }
                   14426:             }
                   14427:         }
                   14428:     }
                   14429:     return @pathitems;
                   14430: }
                   14431: 
                   14432: =pod
                   14433: 
1.1015    raeburn  14434: =item * &get_turnedin_filepath()
                   14435: 
                   14436: Determines path in a user's portfolio file for storage of files uploaded
                   14437: to a specific essayresponse or dropbox item.
                   14438: 
                   14439: Inputs: 3 required + 1 optional.
                   14440: $symb is symb for resource, $uname and $udom are for current user (required).
                   14441: $caller is optional (can be "submission", if routine is called when storing
                   14442: an upoaded file when "Submit Answer" button was pressed).
                   14443: 
                   14444: Returns array containing $path and $multiresp. 
                   14445: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   14446: than one file upload item.  Callers of routine should append partid as a 
                   14447: subdirectory to $path in cases where $multiresp is 1.
                   14448: 
                   14449: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   14450: 
                   14451: =cut
                   14452: 
                   14453: sub get_turnedin_filepath {
                   14454:     my ($symb,$uname,$udom,$caller) = @_;
                   14455:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   14456:     my $turnindir;
                   14457:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   14458:     $turnindir = $userhash{'turnindir'};
                   14459:     my ($path,$multiresp);
                   14460:     if ($turnindir eq '') {
                   14461:         if ($caller eq 'submission') {
                   14462:             $turnindir = &mt('turned in');
                   14463:             $turnindir =~ s/\W+/_/g;
                   14464:             my %newhash = (
                   14465:                             'turnindir' => $turnindir,
                   14466:                           );
                   14467:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   14468:         }
                   14469:     }
                   14470:     if ($turnindir ne '') {
                   14471:         $path = '/'.$turnindir.'/';
                   14472:         my ($multipart,$turnin,@pathitems);
                   14473:         my $navmap = Apache::lonnavmaps::navmap->new();
                   14474:         if (defined($navmap)) {
                   14475:             my $mapres = $navmap->getResourceByUrl($map);
                   14476:             if (ref($mapres)) {
                   14477:                 my $pcslist = $mapres->map_hierarchy();
                   14478:                 if ($pcslist ne '') {
                   14479:                     foreach my $pc (split(/,/,$pcslist)) {
                   14480:                         my $res = $navmap->getByMapPc($pc);
                   14481:                         if (ref($res)) {
                   14482:                             my $title = $res->compTitle();
                   14483:                             $title =~ s/\W+/_/g;
                   14484:                             if ($title ne '') {
1.1075.2.48  raeburn  14485:                                 if (($pc > 1) && (length($title) > 12)) {
                   14486:                                     $title = substr($title,0,12);
                   14487:                                 }
1.1015    raeburn  14488:                                 push(@pathitems,$title);
                   14489:                             }
                   14490:                         }
                   14491:                     }
                   14492:                 }
                   14493:                 my $maptitle = $mapres->compTitle();
                   14494:                 $maptitle =~ s/\W+/_/g;
                   14495:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  14496:                     if (length($maptitle) > 12) {
                   14497:                         $maptitle = substr($maptitle,0,12);
                   14498:                     }
1.1015    raeburn  14499:                     push(@pathitems,$maptitle);
                   14500:                 }
                   14501:                 unless ($env{'request.state'} eq 'construct') {
                   14502:                     my $res = $navmap->getBySymb($symb);
                   14503:                     if (ref($res)) {
                   14504:                         my $partlist = $res->parts();
                   14505:                         my $totaluploads = 0;
                   14506:                         if (ref($partlist) eq 'ARRAY') {
                   14507:                             foreach my $part (@{$partlist}) {
                   14508:                                 my @types = $res->responseType($part);
                   14509:                                 my @ids = $res->responseIds($part);
                   14510:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   14511:                                     if ($types[$i] eq 'essay') {
                   14512:                                         my $partid = $part.'_'.$ids[$i];
                   14513:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   14514:                                             $totaluploads ++;
                   14515:                                         }
                   14516:                                     }
                   14517:                                 }
                   14518:                             }
                   14519:                             if ($totaluploads > 1) {
                   14520:                                 $multiresp = 1;
                   14521:                             }
                   14522:                         }
                   14523:                     }
                   14524:                 }
                   14525:             } else {
                   14526:                 return;
                   14527:             }
                   14528:         } else {
                   14529:             return;
                   14530:         }
                   14531:         my $restitle=&Apache::lonnet::gettitle($symb);
                   14532:         $restitle =~ s/\W+/_/g;
                   14533:         if ($restitle eq '') {
                   14534:             $restitle = ($resurl =~ m{/[^/]+$});
                   14535:             if ($restitle eq '') {
                   14536:                 $restitle = time;
                   14537:             }
                   14538:         }
1.1075.2.48  raeburn  14539:         if (length($restitle) > 12) {
                   14540:             $restitle = substr($restitle,0,12);
                   14541:         }
1.1015    raeburn  14542:         push(@pathitems,$restitle);
                   14543:         $path .= join('/',@pathitems);
                   14544:     }
                   14545:     return ($path,$multiresp);
                   14546: }
                   14547: 
                   14548: =pod
                   14549: 
1.464     albertel 14550: =back
1.41      ng       14551: 
1.112     bowersj2 14552: =head1 CSV Upload/Handling functions
1.38      albertel 14553: 
1.41      ng       14554: =over 4
                   14555: 
1.648     raeburn  14556: =item * &upfile_store($r)
1.41      ng       14557: 
                   14558: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 14559: needs $env{'form.upfile'}
1.41      ng       14560: returns $datatoken to be put into hidden field
                   14561: 
                   14562: =cut
1.31      albertel 14563: 
                   14564: sub upfile_store {
                   14565:     my $r=shift;
1.258     albertel 14566:     $env{'form.upfile'}=~s/\r/\n/gs;
                   14567:     $env{'form.upfile'}=~s/\f/\n/gs;
                   14568:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   14569:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 14570: 
1.1075.2.128  raeburn  14571:     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
                   14572:                                      '_enroll_'.$env{'request.course.id'}.'_'.
                   14573:                                      time.'_'.$$);
                   14574:     return if ($datatoken eq '');
                   14575: 
1.31      albertel 14576:     {
1.158     raeburn  14577:         my $datafile = $r->dir_config('lonDaemons').
                   14578:                            '/tmp/'.$datatoken.'.tmp';
1.1075.2.128  raeburn  14579:         if ( open(my $fh,'>',$datafile) ) {
1.258     albertel 14580:             print $fh $env{'form.upfile'};
1.158     raeburn  14581:             close($fh);
                   14582:         }
1.31      albertel 14583:     }
                   14584:     return $datatoken;
                   14585: }
                   14586: 
1.56      matthew  14587: =pod
                   14588: 
1.1075.2.128  raeburn  14589: =item * &load_tmp_file($r,$datatoken)
1.41      ng       14590: 
                   14591: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1075.2.128  raeburn  14592: $datatoken is the name to assign to the temporary file.
1.258     albertel 14593: sets $env{'form.upfile'} to the contents of the file
1.41      ng       14594: 
                   14595: =cut
1.31      albertel 14596: 
                   14597: sub load_tmp_file {
1.1075.2.128  raeburn  14598:     my ($r,$datatoken) = @_;
                   14599:     return if ($datatoken eq '');
1.31      albertel 14600:     my @studentdata=();
                   14601:     {
1.158     raeburn  14602:         my $studentfile = $r->dir_config('lonDaemons').
1.1075.2.128  raeburn  14603:                               '/tmp/'.$datatoken.'.tmp';
                   14604:         if ( open(my $fh,'<',$studentfile) ) {
1.158     raeburn  14605:             @studentdata=<$fh>;
                   14606:             close($fh);
                   14607:         }
1.31      albertel 14608:     }
1.258     albertel 14609:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 14610: }
                   14611: 
1.1075.2.128  raeburn  14612: sub valid_datatoken {
                   14613:     my ($datatoken) = @_;
1.1075.2.131  raeburn  14614:     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1075.2.128  raeburn  14615:         return $datatoken;
                   14616:     }
                   14617:     return;
                   14618: }
                   14619: 
1.56      matthew  14620: =pod
                   14621: 
1.648     raeburn  14622: =item * &upfile_record_sep()
1.41      ng       14623: 
                   14624: Separate uploaded file into records
                   14625: returns array of records,
1.258     albertel 14626: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       14627: 
                   14628: =cut
1.31      albertel 14629: 
                   14630: sub upfile_record_sep {
1.258     albertel 14631:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 14632:     } else {
1.248     albertel 14633: 	my @records;
1.258     albertel 14634: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 14635: 	    if ($line=~/^\s*$/) { next; }
                   14636: 	    push(@records,$line);
                   14637: 	}
                   14638: 	return @records;
1.31      albertel 14639:     }
                   14640: }
                   14641: 
1.56      matthew  14642: =pod
                   14643: 
1.648     raeburn  14644: =item * &record_sep($record)
1.41      ng       14645: 
1.258     albertel 14646: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       14647: 
                   14648: =cut
                   14649: 
1.263     www      14650: sub takeleft {
                   14651:     my $index=shift;
                   14652:     return substr('0000'.$index,-4,4);
                   14653: }
                   14654: 
1.31      albertel 14655: sub record_sep {
                   14656:     my $record=shift;
                   14657:     my %components=();
1.258     albertel 14658:     if ($env{'form.upfiletype'} eq 'xml') {
                   14659:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 14660:         my $i=0;
1.356     albertel 14661:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 14662:             $field=~s/^(\"|\')//;
                   14663:             $field=~s/(\"|\')$//;
1.263     www      14664:             $components{&takeleft($i)}=$field;
1.31      albertel 14665:             $i++;
                   14666:         }
1.258     albertel 14667:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 14668:         my $i=0;
1.356     albertel 14669:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 14670:             $field=~s/^(\"|\')//;
                   14671:             $field=~s/(\"|\')$//;
1.263     www      14672:             $components{&takeleft($i)}=$field;
1.31      albertel 14673:             $i++;
                   14674:         }
                   14675:     } else {
1.561     www      14676:         my $separator=',';
1.480     banghart 14677:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      14678:             $separator=';';
1.480     banghart 14679:         }
1.31      albertel 14680:         my $i=0;
1.561     www      14681: # the character we are looking for to indicate the end of a quote or a record 
                   14682:         my $looking_for=$separator;
                   14683: # do not add the characters to the fields
                   14684:         my $ignore=0;
                   14685: # we just encountered a separator (or the beginning of the record)
                   14686:         my $just_found_separator=1;
                   14687: # store the field we are working on here
                   14688:         my $field='';
                   14689: # work our way through all characters in record
                   14690:         foreach my $character ($record=~/(.)/g) {
                   14691:             if ($character eq $looking_for) {
                   14692:                if ($character ne $separator) {
                   14693: # Found the end of a quote, again looking for separator
                   14694:                   $looking_for=$separator;
                   14695:                   $ignore=1;
                   14696:                } else {
                   14697: # Found a separator, store away what we got
                   14698:                   $components{&takeleft($i)}=$field;
                   14699: 	          $i++;
                   14700:                   $just_found_separator=1;
                   14701:                   $ignore=0;
                   14702:                   $field='';
                   14703:                }
                   14704:                next;
                   14705:             }
                   14706: # single or double quotation marks after a separator indicate beginning of a quote
                   14707: # we are now looking for the end of the quote and need to ignore separators
                   14708:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   14709:                $looking_for=$character;
                   14710:                next;
                   14711:             }
                   14712: # ignore would be true after we reached the end of a quote
                   14713:             if ($ignore) { next; }
                   14714:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   14715:             $field.=$character;
                   14716:             $just_found_separator=0; 
1.31      albertel 14717:         }
1.561     www      14718: # catch the very last entry, since we never encountered the separator
                   14719:         $components{&takeleft($i)}=$field;
1.31      albertel 14720:     }
                   14721:     return %components;
                   14722: }
                   14723: 
1.144     matthew  14724: ######################################################
                   14725: ######################################################
                   14726: 
1.56      matthew  14727: =pod
                   14728: 
1.648     raeburn  14729: =item * &upfile_select_html()
1.41      ng       14730: 
1.144     matthew  14731: Return HTML code to select a file from the users machine and specify 
                   14732: the file type.
1.41      ng       14733: 
                   14734: =cut
                   14735: 
1.144     matthew  14736: ######################################################
                   14737: ######################################################
1.31      albertel 14738: sub upfile_select_html {
1.144     matthew  14739:     my %Types = (
                   14740:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 14741:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  14742:                  space => &mt('Space separated'),
                   14743:                  tab   => &mt('Tabulator separated'),
                   14744: #                 xml   => &mt('HTML/XML'),
                   14745:                  );
                   14746:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  14747:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  14748:     foreach my $type (sort(keys(%Types))) {
                   14749:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   14750:     }
                   14751:     $Str .= "</select>\n";
                   14752:     return $Str;
1.31      albertel 14753: }
                   14754: 
1.301     albertel 14755: sub get_samples {
                   14756:     my ($records,$toget) = @_;
                   14757:     my @samples=({});
                   14758:     my $got=0;
                   14759:     foreach my $rec (@$records) {
                   14760: 	my %temp = &record_sep($rec);
                   14761: 	if (! grep(/\S/, values(%temp))) { next; }
                   14762: 	if (%temp) {
                   14763: 	    $samples[$got]=\%temp;
                   14764: 	    $got++;
                   14765: 	    if ($got == $toget) { last; }
                   14766: 	}
                   14767:     }
                   14768:     return \@samples;
                   14769: }
                   14770: 
1.144     matthew  14771: ######################################################
                   14772: ######################################################
                   14773: 
1.56      matthew  14774: =pod
                   14775: 
1.648     raeburn  14776: =item * &csv_print_samples($r,$records)
1.41      ng       14777: 
                   14778: Prints a table of sample values from each column uploaded $r is an
                   14779: Apache Request ref, $records is an arrayref from
                   14780: &Apache::loncommon::upfile_record_sep
                   14781: 
                   14782: =cut
                   14783: 
1.144     matthew  14784: ######################################################
                   14785: ######################################################
1.31      albertel 14786: sub csv_print_samples {
                   14787:     my ($r,$records) = @_;
1.662     bisitz   14788:     my $samples = &get_samples($records,5);
1.301     albertel 14789: 
1.594     raeburn  14790:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   14791:               &start_data_table_header_row());
1.356     albertel 14792:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   14793:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  14794:     $r->print(&end_data_table_header_row());
1.301     albertel 14795:     foreach my $hash (@$samples) {
1.594     raeburn  14796: 	$r->print(&start_data_table_row());
1.356     albertel 14797: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 14798: 	    $r->print('<td>');
1.356     albertel 14799: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 14800: 	    $r->print('</td>');
                   14801: 	}
1.594     raeburn  14802: 	$r->print(&end_data_table_row());
1.31      albertel 14803:     }
1.594     raeburn  14804:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 14805: }
                   14806: 
1.144     matthew  14807: ######################################################
                   14808: ######################################################
                   14809: 
1.56      matthew  14810: =pod
                   14811: 
1.648     raeburn  14812: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       14813: 
                   14814: Prints a table to create associations between values and table columns.
1.144     matthew  14815: 
1.41      ng       14816: $r is an Apache Request ref,
                   14817: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  14818: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       14819: 
                   14820: =cut
                   14821: 
1.144     matthew  14822: ######################################################
                   14823: ######################################################
1.31      albertel 14824: sub csv_print_select_table {
                   14825:     my ($r,$records,$d) = @_;
1.301     albertel 14826:     my $i=0;
                   14827:     my $samples = &get_samples($records,1);
1.144     matthew  14828:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  14829: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  14830:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  14831:               '<th>'.&mt('Column').'</th>'.
                   14832:               &end_data_table_header_row()."\n");
1.356     albertel 14833:     foreach my $array_ref (@$d) {
                   14834: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  14835: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 14836: 
1.875     bisitz   14837: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  14838: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 14839: 	$r->print('<option value="none"></option>');
1.356     albertel 14840: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   14841: 	    $r->print('<option value="'.$sample.'"'.
                   14842:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   14843:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 14844: 	}
1.594     raeburn  14845: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 14846: 	$i++;
                   14847:     }
1.594     raeburn  14848:     $r->print(&end_data_table());
1.31      albertel 14849:     $i--;
                   14850:     return $i;
                   14851: }
1.56      matthew  14852: 
1.144     matthew  14853: ######################################################
                   14854: ######################################################
                   14855: 
1.56      matthew  14856: =pod
1.31      albertel 14857: 
1.648     raeburn  14858: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       14859: 
                   14860: Prints a table of sample values from the upload and can make associate samples to internal names.
                   14861: 
                   14862: $r is an Apache Request ref,
                   14863: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   14864: $d is an array of 2 element arrays (internal name, displayed name)
                   14865: 
                   14866: =cut
                   14867: 
1.144     matthew  14868: ######################################################
                   14869: ######################################################
1.31      albertel 14870: sub csv_samples_select_table {
                   14871:     my ($r,$records,$d) = @_;
                   14872:     my $i=0;
1.144     matthew  14873:     #
1.662     bisitz   14874:     my $max_samples = 5;
                   14875:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  14876:     $r->print(&start_data_table().
                   14877:               &start_data_table_header_row().'<th>'.
                   14878:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   14879:               &end_data_table_header_row());
1.301     albertel 14880: 
                   14881:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  14882: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  14883: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 14884: 	foreach my $option (@$d) {
                   14885: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  14886: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 14887:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  14888:                       $display.'</option>');
1.31      albertel 14889: 	}
                   14890: 	$r->print('</select></td><td>');
1.662     bisitz   14891: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 14892: 	    if (defined($samples->[$line]{$key})) { 
                   14893: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   14894: 	    }
                   14895: 	}
1.594     raeburn  14896: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 14897: 	$i++;
                   14898:     }
1.594     raeburn  14899:     $r->print(&end_data_table());
1.31      albertel 14900:     $i--;
                   14901:     return($i);
1.115     matthew  14902: }
                   14903: 
1.144     matthew  14904: ######################################################
                   14905: ######################################################
                   14906: 
1.115     matthew  14907: =pod
                   14908: 
1.648     raeburn  14909: =item * &clean_excel_name($name)
1.115     matthew  14910: 
                   14911: Returns a replacement for $name which does not contain any illegal characters.
                   14912: 
                   14913: =cut
                   14914: 
1.144     matthew  14915: ######################################################
                   14916: ######################################################
1.115     matthew  14917: sub clean_excel_name {
                   14918:     my ($name) = @_;
                   14919:     $name =~ s/[:\*\?\/\\]//g;
                   14920:     if (length($name) > 31) {
                   14921:         $name = substr($name,0,31);
                   14922:     }
                   14923:     return $name;
1.25      albertel 14924: }
1.84      albertel 14925: 
1.85      albertel 14926: =pod
                   14927: 
1.648     raeburn  14928: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 14929: 
                   14930: Returns either 1 or undef
                   14931: 
                   14932: 1 if the part is to be hidden, undef if it is to be shown
                   14933: 
                   14934: Arguments are:
                   14935: 
                   14936: $id the id of the part to be checked
                   14937: $symb, optional the symb of the resource to check
                   14938: $udom, optional the domain of the user to check for
                   14939: $uname, optional the username of the user to check for
                   14940: 
                   14941: =cut
1.84      albertel 14942: 
                   14943: sub check_if_partid_hidden {
                   14944:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 14945:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 14946: 					 $symb,$udom,$uname);
1.141     albertel 14947:     my $truth=1;
                   14948:     #if the string starts with !, then the list is the list to show not hide
                   14949:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 14950:     my @hiddenlist=split(/,/,$hiddenparts);
                   14951:     foreach my $checkid (@hiddenlist) {
1.141     albertel 14952: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 14953:     }
1.141     albertel 14954:     return !$truth;
1.84      albertel 14955: }
1.127     matthew  14956: 
1.138     matthew  14957: 
                   14958: ############################################################
                   14959: ############################################################
                   14960: 
                   14961: =pod
                   14962: 
1.157     matthew  14963: =back 
                   14964: 
1.138     matthew  14965: =head1 cgi-bin script and graphing routines
                   14966: 
1.157     matthew  14967: =over 4
                   14968: 
1.648     raeburn  14969: =item * &get_cgi_id()
1.138     matthew  14970: 
                   14971: Inputs: none
                   14972: 
                   14973: Returns an id which can be used to pass environment variables
                   14974: to various cgi-bin scripts.  These environment variables will
                   14975: be removed from the users environment after a given time by
                   14976: the routine &Apache::lonnet::transfer_profile_to_env.
                   14977: 
                   14978: =cut
                   14979: 
                   14980: ############################################################
                   14981: ############################################################
1.152     albertel 14982: my $uniq=0;
1.136     matthew  14983: sub get_cgi_id {
1.154     albertel 14984:     $uniq=($uniq+1)%100000;
1.280     albertel 14985:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  14986: }
                   14987: 
1.127     matthew  14988: ############################################################
                   14989: ############################################################
                   14990: 
                   14991: =pod
                   14992: 
1.648     raeburn  14993: =item * &DrawBarGraph()
1.127     matthew  14994: 
1.138     matthew  14995: Facilitates the plotting of data in a (stacked) bar graph.
                   14996: Puts plot definition data into the users environment in order for 
                   14997: graph.png to plot it.  Returns an <img> tag for the plot.
                   14998: The bars on the plot are labeled '1','2',...,'n'.
                   14999: 
                   15000: Inputs:
                   15001: 
                   15002: =over 4
                   15003: 
                   15004: =item $Title: string, the title of the plot
                   15005: 
                   15006: =item $xlabel: string, text describing the X-axis of the plot
                   15007: 
                   15008: =item $ylabel: string, text describing the Y-axis of the plot
                   15009: 
                   15010: =item $Max: scalar, the maximum Y value to use in the plot
                   15011: If $Max is < any data point, the graph will not be rendered.
                   15012: 
1.140     matthew  15013: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  15014: they are plotted.  If undefined, default values will be used.
                   15015: 
1.178     matthew  15016: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   15017: 
1.138     matthew  15018: =item @Values: An array of array references.  Each array reference holds data
                   15019: to be plotted in a stacked bar chart.
                   15020: 
1.239     matthew  15021: =item If the final element of @Values is a hash reference the key/value
                   15022: pairs will be added to the graph definition.
                   15023: 
1.138     matthew  15024: =back
                   15025: 
                   15026: Returns:
                   15027: 
                   15028: An <img> tag which references graph.png and the appropriate identifying
                   15029: information for the plot.
                   15030: 
1.127     matthew  15031: =cut
                   15032: 
                   15033: ############################################################
                   15034: ############################################################
1.134     matthew  15035: sub DrawBarGraph {
1.178     matthew  15036:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  15037:     #
                   15038:     if (! defined($colors)) {
                   15039:         $colors = ['#33ff00', 
                   15040:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   15041:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   15042:                   ]; 
                   15043:     }
1.228     matthew  15044:     my $extra_settings = {};
                   15045:     if (ref($Values[-1]) eq 'HASH') {
                   15046:         $extra_settings = pop(@Values);
                   15047:     }
1.127     matthew  15048:     #
1.136     matthew  15049:     my $identifier = &get_cgi_id();
                   15050:     my $id = 'cgi.'.$identifier;        
1.129     matthew  15051:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  15052:         return '';
                   15053:     }
1.225     matthew  15054:     #
                   15055:     my @Labels;
                   15056:     if (defined($labels)) {
                   15057:         @Labels = @$labels;
                   15058:     } else {
                   15059:         for (my $i=0;$i<@{$Values[0]};$i++) {
1.1075.2.119  raeburn  15060:             push(@Labels,$i+1);
1.225     matthew  15061:         }
                   15062:     }
                   15063:     #
1.129     matthew  15064:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  15065:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  15066:     my %ValuesHash;
                   15067:     my $NumSets=1;
                   15068:     foreach my $array (@Values) {
                   15069:         next if (! ref($array));
1.136     matthew  15070:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  15071:             join(',',@$array);
1.129     matthew  15072:     }
1.127     matthew  15073:     #
1.136     matthew  15074:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  15075:     if ($NumBars < 3) {
                   15076:         $width = 120+$NumBars*32;
1.220     matthew  15077:         $xskip = 1;
1.225     matthew  15078:         $bar_width = 30;
                   15079:     } elsif ($NumBars < 5) {
                   15080:         $width = 120+$NumBars*20;
                   15081:         $xskip = 1;
                   15082:         $bar_width = 20;
1.220     matthew  15083:     } elsif ($NumBars < 10) {
1.136     matthew  15084:         $width = 120+$NumBars*15;
                   15085:         $xskip = 1;
                   15086:         $bar_width = 15;
                   15087:     } elsif ($NumBars <= 25) {
                   15088:         $width = 120+$NumBars*11;
                   15089:         $xskip = 5;
                   15090:         $bar_width = 8;
                   15091:     } elsif ($NumBars <= 50) {
                   15092:         $width = 120+$NumBars*8;
                   15093:         $xskip = 5;
                   15094:         $bar_width = 4;
                   15095:     } else {
                   15096:         $width = 120+$NumBars*8;
                   15097:         $xskip = 5;
                   15098:         $bar_width = 4;
                   15099:     }
                   15100:     #
1.137     matthew  15101:     $Max = 1 if ($Max < 1);
                   15102:     if ( int($Max) < $Max ) {
                   15103:         $Max++;
                   15104:         $Max = int($Max);
                   15105:     }
1.127     matthew  15106:     $Title  = '' if (! defined($Title));
                   15107:     $xlabel = '' if (! defined($xlabel));
                   15108:     $ylabel = '' if (! defined($ylabel));
1.369     www      15109:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   15110:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   15111:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  15112:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  15113:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   15114:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   15115:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   15116:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15117:     $ValuesHash{$id.'.height'}   = $height;
                   15118:     $ValuesHash{$id.'.width'}    = $width;
                   15119:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   15120:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   15121:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  15122:     #
1.228     matthew  15123:     # Deal with other parameters
                   15124:     while (my ($key,$value) = each(%$extra_settings)) {
                   15125:         $ValuesHash{$id.'.'.$key} = $value;
                   15126:     }
                   15127:     #
1.646     raeburn  15128:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  15129:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   15130: }
                   15131: 
                   15132: ############################################################
                   15133: ############################################################
                   15134: 
                   15135: =pod
                   15136: 
1.648     raeburn  15137: =item * &DrawXYGraph()
1.137     matthew  15138: 
1.138     matthew  15139: Facilitates the plotting of data in an XY graph.
                   15140: Puts plot definition data into the users environment in order for 
                   15141: graph.png to plot it.  Returns an <img> tag for the plot.
                   15142: 
                   15143: Inputs:
                   15144: 
                   15145: =over 4
                   15146: 
                   15147: =item $Title: string, the title of the plot
                   15148: 
                   15149: =item $xlabel: string, text describing the X-axis of the plot
                   15150: 
                   15151: =item $ylabel: string, text describing the Y-axis of the plot
                   15152: 
                   15153: =item $Max: scalar, the maximum Y value to use in the plot
                   15154: If $Max is < any data point, the graph will not be rendered.
                   15155: 
                   15156: =item $colors: Array ref containing the hex color codes for the data to be 
                   15157: plotted in.  If undefined, default values will be used.
                   15158: 
                   15159: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   15160: 
                   15161: =item $Ydata: Array ref containing Array refs.  
1.185     www      15162: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  15163: 
                   15164: =item %Values: hash indicating or overriding any default values which are 
                   15165: passed to graph.png.  
                   15166: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   15167: 
                   15168: =back
                   15169: 
                   15170: Returns:
                   15171: 
                   15172: An <img> tag which references graph.png and the appropriate identifying
                   15173: information for the plot.
                   15174: 
1.137     matthew  15175: =cut
                   15176: 
                   15177: ############################################################
                   15178: ############################################################
                   15179: sub DrawXYGraph {
                   15180:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   15181:     #
                   15182:     # Create the identifier for the graph
                   15183:     my $identifier = &get_cgi_id();
                   15184:     my $id = 'cgi.'.$identifier;
                   15185:     #
                   15186:     $Title  = '' if (! defined($Title));
                   15187:     $xlabel = '' if (! defined($xlabel));
                   15188:     $ylabel = '' if (! defined($ylabel));
                   15189:     my %ValuesHash = 
                   15190:         (
1.369     www      15191:          $id.'.title'  => &escape($Title),
                   15192:          $id.'.xlabel' => &escape($xlabel),
                   15193:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  15194:          $id.'.y_max_value'=> $Max,
                   15195:          $id.'.labels'     => join(',',@$Xlabels),
                   15196:          $id.'.PlotType'   => 'XY',
                   15197:          );
                   15198:     #
                   15199:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   15200:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15201:     }
                   15202:     #
                   15203:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   15204:         return '';
                   15205:     }
                   15206:     my $NumSets=1;
1.138     matthew  15207:     foreach my $array (@{$Ydata}){
1.137     matthew  15208:         next if (! ref($array));
                   15209:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   15210:     }
1.138     matthew  15211:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  15212:     #
                   15213:     # Deal with other parameters
                   15214:     while (my ($key,$value) = each(%Values)) {
                   15215:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  15216:     }
                   15217:     #
1.646     raeburn  15218:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  15219:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   15220: }
                   15221: 
                   15222: ############################################################
                   15223: ############################################################
                   15224: 
                   15225: =pod
                   15226: 
1.648     raeburn  15227: =item * &DrawXYYGraph()
1.138     matthew  15228: 
                   15229: Facilitates the plotting of data in an XY graph with two Y axes.
                   15230: Puts plot definition data into the users environment in order for 
                   15231: graph.png to plot it.  Returns an <img> tag for the plot.
                   15232: 
                   15233: Inputs:
                   15234: 
                   15235: =over 4
                   15236: 
                   15237: =item $Title: string, the title of the plot
                   15238: 
                   15239: =item $xlabel: string, text describing the X-axis of the plot
                   15240: 
                   15241: =item $ylabel: string, text describing the Y-axis of the plot
                   15242: 
                   15243: =item $colors: Array ref containing the hex color codes for the data to be 
                   15244: plotted in.  If undefined, default values will be used.
                   15245: 
                   15246: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   15247: 
                   15248: =item $Ydata1: The first data set
                   15249: 
                   15250: =item $Min1: The minimum value of the left Y-axis
                   15251: 
                   15252: =item $Max1: The maximum value of the left Y-axis
                   15253: 
                   15254: =item $Ydata2: The second data set
                   15255: 
                   15256: =item $Min2: The minimum value of the right Y-axis
                   15257: 
                   15258: =item $Max2: The maximum value of the left Y-axis
                   15259: 
                   15260: =item %Values: hash indicating or overriding any default values which are 
                   15261: passed to graph.png.  
                   15262: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   15263: 
                   15264: =back
                   15265: 
                   15266: Returns:
                   15267: 
                   15268: An <img> tag which references graph.png and the appropriate identifying
                   15269: information for the plot.
1.136     matthew  15270: 
                   15271: =cut
                   15272: 
                   15273: ############################################################
                   15274: ############################################################
1.137     matthew  15275: sub DrawXYYGraph {
                   15276:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   15277:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  15278:     #
                   15279:     # Create the identifier for the graph
                   15280:     my $identifier = &get_cgi_id();
                   15281:     my $id = 'cgi.'.$identifier;
                   15282:     #
                   15283:     $Title  = '' if (! defined($Title));
                   15284:     $xlabel = '' if (! defined($xlabel));
                   15285:     $ylabel = '' if (! defined($ylabel));
                   15286:     my %ValuesHash = 
                   15287:         (
1.369     www      15288:          $id.'.title'  => &escape($Title),
                   15289:          $id.'.xlabel' => &escape($xlabel),
                   15290:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  15291:          $id.'.labels' => join(',',@$Xlabels),
                   15292:          $id.'.PlotType' => 'XY',
                   15293:          $id.'.NumSets' => 2,
1.137     matthew  15294:          $id.'.two_axes' => 1,
                   15295:          $id.'.y1_max_value' => $Max1,
                   15296:          $id.'.y1_min_value' => $Min1,
                   15297:          $id.'.y2_max_value' => $Max2,
                   15298:          $id.'.y2_min_value' => $Min2,
1.136     matthew  15299:          );
                   15300:     #
1.137     matthew  15301:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   15302:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15303:     }
                   15304:     #
                   15305:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   15306:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  15307:         return '';
                   15308:     }
                   15309:     my $NumSets=1;
1.137     matthew  15310:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  15311:         next if (! ref($array));
                   15312:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  15313:     }
                   15314:     #
                   15315:     # Deal with other parameters
                   15316:     while (my ($key,$value) = each(%Values)) {
                   15317:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  15318:     }
                   15319:     #
1.646     raeburn  15320:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 15321:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  15322: }
                   15323: 
                   15324: ############################################################
                   15325: ############################################################
                   15326: 
                   15327: =pod
                   15328: 
1.157     matthew  15329: =back 
                   15330: 
1.139     matthew  15331: =head1 Statistics helper routines?  
                   15332: 
                   15333: Bad place for them but what the hell.
                   15334: 
1.157     matthew  15335: =over 4
                   15336: 
1.648     raeburn  15337: =item * &chartlink()
1.139     matthew  15338: 
                   15339: Returns a link to the chart for a specific student.  
                   15340: 
                   15341: Inputs:
                   15342: 
                   15343: =over 4
                   15344: 
                   15345: =item $linktext: The text of the link
                   15346: 
                   15347: =item $sname: The students username
                   15348: 
                   15349: =item $sdomain: The students domain
                   15350: 
                   15351: =back
                   15352: 
1.157     matthew  15353: =back
                   15354: 
1.139     matthew  15355: =cut
                   15356: 
                   15357: ############################################################
                   15358: ############################################################
                   15359: sub chartlink {
                   15360:     my ($linktext, $sname, $sdomain) = @_;
                   15361:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      15362:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 15363:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  15364:        '">'.$linktext.'</a>';
1.153     matthew  15365: }
                   15366: 
                   15367: #######################################################
                   15368: #######################################################
                   15369: 
                   15370: =pod
                   15371: 
                   15372: =head1 Course Environment Routines
1.157     matthew  15373: 
                   15374: =over 4
1.153     matthew  15375: 
1.648     raeburn  15376: =item * &restore_course_settings()
1.153     matthew  15377: 
1.648     raeburn  15378: =item * &store_course_settings()
1.153     matthew  15379: 
                   15380: Restores/Store indicated form parameters from the course environment.
                   15381: Will not overwrite existing values of the form parameters.
                   15382: 
                   15383: Inputs: 
                   15384: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   15385: 
                   15386: a hash ref describing the data to be stored.  For example:
                   15387:    
                   15388: %Save_Parameters = ('Status' => 'scalar',
                   15389:     'chartoutputmode' => 'scalar',
                   15390:     'chartoutputdata' => 'scalar',
                   15391:     'Section' => 'array',
1.373     raeburn  15392:     'Group' => 'array',
1.153     matthew  15393:     'StudentData' => 'array',
                   15394:     'Maps' => 'array');
                   15395: 
                   15396: Returns: both routines return nothing
                   15397: 
1.631     raeburn  15398: =back
                   15399: 
1.153     matthew  15400: =cut
                   15401: 
                   15402: #######################################################
                   15403: #######################################################
                   15404: sub store_course_settings {
1.496     albertel 15405:     return &store_settings($env{'request.course.id'},@_);
                   15406: }
                   15407: 
                   15408: sub store_settings {
1.153     matthew  15409:     # save to the environment
                   15410:     # appenv the same items, just to be safe
1.300     albertel 15411:     my $udom  = $env{'user.domain'};
                   15412:     my $uname = $env{'user.name'};
1.496     albertel 15413:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  15414:     my %SaveHash;
                   15415:     my %AppHash;
                   15416:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 15417:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 15418:         my $envname = 'environment.'.$basename;
1.258     albertel 15419:         if (exists($env{'form.'.$setting})) {
1.153     matthew  15420:             # Save this value away
                   15421:             if ($type eq 'scalar' &&
1.258     albertel 15422:                 (! exists($env{$envname}) || 
                   15423:                  $env{$envname} ne $env{'form.'.$setting})) {
                   15424:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   15425:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  15426:             } elsif ($type eq 'array') {
                   15427:                 my $stored_form;
1.258     albertel 15428:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  15429:                     $stored_form = join(',',
                   15430:                                         map {
1.369     www      15431:                                             &escape($_);
1.258     albertel 15432:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  15433:                 } else {
                   15434:                     $stored_form = 
1.369     www      15435:                         &escape($env{'form.'.$setting});
1.153     matthew  15436:                 }
                   15437:                 # Determine if the array contents are the same.
1.258     albertel 15438:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  15439:                     $SaveHash{$basename} = $stored_form;
                   15440:                     $AppHash{$envname}   = $stored_form;
                   15441:                 }
                   15442:             }
                   15443:         }
                   15444:     }
                   15445:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 15446:                                           $udom,$uname);
1.153     matthew  15447:     if ($put_result !~ /^(ok|delayed)/) {
                   15448:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   15449:                                  'got error:'.$put_result);
                   15450:     }
                   15451:     # Make sure these settings stick around in this session, too
1.646     raeburn  15452:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  15453:     return;
                   15454: }
                   15455: 
                   15456: sub restore_course_settings {
1.499     albertel 15457:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 15458: }
                   15459: 
                   15460: sub restore_settings {
                   15461:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  15462:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 15463:         next if (exists($env{'form.'.$setting}));
1.496     albertel 15464:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  15465:             '.'.$setting;
1.258     albertel 15466:         if (exists($env{$envname})) {
1.153     matthew  15467:             if ($type eq 'scalar') {
1.258     albertel 15468:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  15469:             } elsif ($type eq 'array') {
1.258     albertel 15470:                 $env{'form.'.$setting} = [ 
1.153     matthew  15471:                                            map { 
1.369     www      15472:                                                &unescape($_); 
1.258     albertel 15473:                                            } split(',',$env{$envname})
1.153     matthew  15474:                                            ];
                   15475:             }
                   15476:         }
                   15477:     }
1.127     matthew  15478: }
                   15479: 
1.618     raeburn  15480: #######################################################
                   15481: #######################################################
                   15482: 
                   15483: =pod
                   15484: 
                   15485: =head1 Domain E-mail Routines  
                   15486: 
                   15487: =over 4
                   15488: 
1.648     raeburn  15489: =item * &build_recipient_list()
1.618     raeburn  15490: 
1.1075.2.44  raeburn  15491: Build recipient lists for following types of e-mail:
1.766     raeburn  15492: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  15493: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   15494: module change checking, student/employee ID conflict checks, as
                   15495: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   15496: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  15497: 
                   15498: Inputs:
1.1075.2.44  raeburn  15499: defmail (scalar - email address of default recipient),
                   15500: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   15501: requestsmail, updatesmail, or idconflictsmail).
                   15502: 
1.619     raeburn  15503: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  15504: 
                   15505: origmail (scalar - email address of recipient from loncapa.conf,
                   15506: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  15507: 
1.1075.2.139  raeburn  15508: $requname username of requester (if mailing type is helpdeskmail)
                   15509: 
                   15510: $requdom domain of requester (if mailing type is helpdeskmail)
                   15511: 
                   15512: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
                   15513: 
1.655     raeburn  15514: Returns: comma separated list of addresses to which to send e-mail.
                   15515: 
                   15516: =back
1.618     raeburn  15517: 
                   15518: =cut
                   15519: 
                   15520: ############################################################
                   15521: ############################################################
                   15522: sub build_recipient_list {
1.1075.2.139  raeburn  15523:     my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618     raeburn  15524:     my @recipients;
1.1075.2.122  raeburn  15525:     my ($otheremails,$lastresort,$allbcc,$addtext);
1.618     raeburn  15526:     my %domconfig =
1.1075.2.122  raeburn  15527:         &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618     raeburn  15528:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  15529:         if (exists($domconfig{'contacts'}{$mailing})) {
                   15530:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   15531:                 my @contacts = ('adminemail','supportemail');
                   15532:                 foreach my $item (@contacts) {
                   15533:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   15534:                         my $addr = $domconfig{'contacts'}{$item}; 
                   15535:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15536:                             push(@recipients,$addr);
                   15537:                         }
1.619     raeburn  15538:                     }
1.1075.2.122  raeburn  15539:                 }
                   15540:                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   15541:                 if ($mailing eq 'helpdeskmail') {
                   15542:                     if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                   15543:                         my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                   15544:                         my @ok_bccs;
                   15545:                         foreach my $bcc (@bccs) {
                   15546:                             $bcc =~ s/^\s+//g;
                   15547:                             $bcc =~ s/\s+$//g;
                   15548:                             if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   15549:                                 if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   15550:                                     push(@ok_bccs,$bcc);
                   15551:                                 }
                   15552:                             }
                   15553:                         }
                   15554:                         if (@ok_bccs > 0) {
                   15555:                             $allbcc = join(', ',@ok_bccs);
                   15556:                         }
                   15557:                     }
                   15558:                     $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618     raeburn  15559:                 }
                   15560:             }
1.766     raeburn  15561:         } elsif ($origmail ne '') {
1.1075.2.122  raeburn  15562:             $lastresort = $origmail;
1.618     raeburn  15563:         }
1.1075.2.139  raeburn  15564:         if ($mailing eq 'helpdeskmail') {
                   15565:             if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
                   15566:                 (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
                   15567:                 my ($inststatus,$inststatus_checked);
                   15568:                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
                   15569:                     ($env{'user.domain'} ne 'public')) {
                   15570:                     $inststatus_checked = 1;
                   15571:                     $inststatus = $env{'environment.inststatus'};
                   15572:                 }
                   15573:                 unless ($inststatus_checked) {
                   15574:                     if (($requname ne '') && ($requdom ne '')) {
                   15575:                         if (($requname =~ /^$match_username$/) &&
                   15576:                             ($requdom =~ /^$match_domain$/) &&
                   15577:                             (&Apache::lonnet::domain($requdom))) {
                   15578:                             my $requhome = &Apache::lonnet::homeserver($requname,
                   15579:                                                                       $requdom);
                   15580:                             unless ($requhome eq 'no_host') {
                   15581:                                 my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
                   15582:                                 $inststatus = $userenv{'inststatus'};
                   15583:                                 $inststatus_checked = 1;
                   15584:                             }
                   15585:                         }
                   15586:                     }
                   15587:                 }
                   15588:                 unless ($inststatus_checked) {
                   15589:                     if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
                   15590:                         my %srch = (srchby     => 'email',
                   15591:                                     srchdomain => $defdom,
                   15592:                                     srchterm   => $reqemail,
                   15593:                                     srchtype   => 'exact');
                   15594:                         my %srch_results = &Apache::lonnet::usersearch(\%srch);
                   15595:                         foreach my $uname (keys(%srch_results)) {
                   15596:                             if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   15597:                                 $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   15598:                                 $inststatus_checked = 1;
                   15599:                                 last;
                   15600:                             }
                   15601:                         }
                   15602:                         unless ($inststatus_checked) {
                   15603:                             my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
                   15604:                             if ($dirsrchres eq 'ok') {
                   15605:                                 foreach my $uname (keys(%srch_results)) {
                   15606:                                     if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   15607:                                         $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   15608:                                         $inststatus_checked = 1;
                   15609:                                         last;
                   15610:                                     }
                   15611:                                 }
                   15612:                             }
                   15613:                         }
                   15614:                     }
                   15615:                 }
                   15616:                 if ($inststatus ne '') {
                   15617:                     foreach my $status (split(/\:/,$inststatus)) {
                   15618:                         if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
                   15619:                             my @contacts = ('adminemail','supportemail');
                   15620:                             foreach my $item (@contacts) {
                   15621:                                 if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
                   15622:                                     my $addr = $domconfig{'contacts'}{'overrides'}{$status};
                   15623:                                     if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15624:                                         push(@recipients,$addr);
                   15625:                                     }
                   15626:                                 }
                   15627:                             }
                   15628:                             $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
                   15629:                             if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
                   15630:                                 my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
                   15631:                                 my @ok_bccs;
                   15632:                                 foreach my $bcc (@bccs) {
                   15633:                                     $bcc =~ s/^\s+//g;
                   15634:                                     $bcc =~ s/\s+$//g;
                   15635:                                     if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   15636:                                         if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   15637:                                             push(@ok_bccs,$bcc);
                   15638:                                         }
                   15639:                                     }
                   15640:                                 }
                   15641:                                 if (@ok_bccs > 0) {
                   15642:                                     $allbcc = join(', ',@ok_bccs);
                   15643:                                 }
                   15644:                             }
                   15645:                             $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
                   15646:                             last;
                   15647:                         }
                   15648:                     }
                   15649:                 }
                   15650:             }
                   15651:         }
1.619     raeburn  15652:     } elsif ($origmail ne '') {
1.1075.2.122  raeburn  15653:         $lastresort = $origmail;
                   15654:     }
1.1075.2.128  raeburn  15655:     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1075.2.122  raeburn  15656:         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
                   15657:             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   15658:             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
                   15659:             my %what = (
                   15660:                           perlvar => 1,
                   15661:                        );
                   15662:             my $primary = &Apache::lonnet::domain($defdom,'primary');
                   15663:             if ($primary) {
                   15664:                 my $gotaddr;
                   15665:                 my ($result,$returnhash) =
                   15666:                     &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   15667:                 if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                   15668:                     if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                   15669:                         $lastresort = $returnhash->{'lonSupportEMail'};
                   15670:                         $gotaddr = 1;
                   15671:                     }
                   15672:                 }
                   15673:                 unless ($gotaddr) {
                   15674:                     my $uintdom = &Apache::lonnet::internet_dom($primary);
                   15675:                     my $intdom = &Apache::lonnet::internet_dom($lonhost);
                   15676:                     unless ($uintdom eq $intdom) {
                   15677:                         my %domconfig =
                   15678:                             &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                   15679:                         if (ref($domconfig{'contacts'}) eq 'HASH') {
                   15680:                             if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                   15681:                                 my @contacts = ('adminemail','supportemail');
                   15682:                                 foreach my $item (@contacts) {
                   15683:                                     if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                   15684:                                         my $addr = $domconfig{'contacts'}{$item};
                   15685:                                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15686:                                             push(@recipients,$addr);
                   15687:                                         }
                   15688:                                     }
                   15689:                                 }
                   15690:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                   15691:                                     $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                   15692:                                 }
                   15693:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                   15694:                                     my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                   15695:                                     my @ok_bccs;
                   15696:                                     foreach my $bcc (@bccs) {
                   15697:                                         $bcc =~ s/^\s+//g;
                   15698:                                         $bcc =~ s/\s+$//g;
                   15699:                                         if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   15700:                                             if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   15701:                                                 push(@ok_bccs,$bcc);
                   15702:                                             }
                   15703:                                         }
                   15704:                                     }
                   15705:                                     if (@ok_bccs > 0) {
                   15706:                                         $allbcc = join(', ',@ok_bccs);
                   15707:                                     }
                   15708:                                 }
                   15709:                                 $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                   15710:                             }
                   15711:                         }
                   15712:                     }
                   15713:                 }
                   15714:             }
                   15715:         }
1.618     raeburn  15716:     }
1.688     raeburn  15717:     if (defined($defmail)) {
                   15718:         if ($defmail ne '') {
                   15719:             push(@recipients,$defmail);
                   15720:         }
1.618     raeburn  15721:     }
                   15722:     if ($otheremails) {
1.619     raeburn  15723:         my @others;
                   15724:         if ($otheremails =~ /,/) {
                   15725:             @others = split(/,/,$otheremails);
1.618     raeburn  15726:         } else {
1.619     raeburn  15727:             push(@others,$otheremails);
                   15728:         }
                   15729:         foreach my $addr (@others) {
                   15730:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   15731:                 push(@recipients,$addr);
                   15732:             }
1.618     raeburn  15733:         }
                   15734:     }
1.1075.2.128  raeburn  15735:     if ($mailing eq 'helpdeskmail') {
1.1075.2.122  raeburn  15736:         if ((!@recipients) && ($lastresort ne '')) {
                   15737:             push(@recipients,$lastresort);
                   15738:         }
                   15739:     } elsif ($lastresort ne '') {
                   15740:         if (!grep(/^\Q$lastresort\E$/,@recipients)) {
                   15741:             push(@recipients,$lastresort);
                   15742:         }
                   15743:     }
                   15744:     my $recipientlist = join(',',@recipients);
                   15745:     if (wantarray) {
                   15746:         return ($recipientlist,$allbcc,$addtext);
                   15747:     } else {
                   15748:         return $recipientlist;
                   15749:     }
1.618     raeburn  15750: }
                   15751: 
1.127     matthew  15752: ############################################################
                   15753: ############################################################
1.154     albertel 15754: 
1.655     raeburn  15755: =pod
                   15756: 
                   15757: =head1 Course Catalog Routines
                   15758: 
                   15759: =over 4
                   15760: 
                   15761: =item * &gather_categories()
                   15762: 
                   15763: Converts category definitions - keys of categories hash stored in  
                   15764: coursecategories in configuration.db on the primary library server in a 
                   15765: domain - to an array.  Also generates javascript and idx hash used to 
                   15766: generate Domain Coordinator interface for editing Course Categories.
                   15767: 
                   15768: Inputs:
1.663     raeburn  15769: 
1.655     raeburn  15770: categories (reference to hash of category definitions).
1.663     raeburn  15771: 
1.655     raeburn  15772: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   15773:       categories and subcategories).
1.663     raeburn  15774: 
1.655     raeburn  15775: idx (reference to hash of counters used in Domain Coordinator interface for 
                   15776:       editing Course Categories).
1.663     raeburn  15777: 
1.655     raeburn  15778: jsarray (reference to array of categories used to create Javascript arrays for
                   15779:          Domain Coordinator interface for editing Course Categories).
                   15780: 
                   15781: Returns: nothing
                   15782: 
                   15783: Side effects: populates cats, idx and jsarray. 
                   15784: 
                   15785: =cut
                   15786: 
                   15787: sub gather_categories {
                   15788:     my ($categories,$cats,$idx,$jsarray) = @_;
                   15789:     my %counters;
                   15790:     my $num = 0;
                   15791:     foreach my $item (keys(%{$categories})) {
                   15792:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   15793:         if ($container eq '' && $depth == 0) {
                   15794:             $cats->[$depth][$categories->{$item}] = $cat;
                   15795:         } else {
                   15796:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   15797:         }
                   15798:         my ($escitem,$tail) = split(/:/,$item,2);
                   15799:         if ($counters{$tail} eq '') {
                   15800:             $counters{$tail} = $num;
                   15801:             $num ++;
                   15802:         }
                   15803:         if (ref($idx) eq 'HASH') {
                   15804:             $idx->{$item} = $counters{$tail};
                   15805:         }
                   15806:         if (ref($jsarray) eq 'ARRAY') {
                   15807:             push(@{$jsarray->[$counters{$tail}]},$item);
                   15808:         }
                   15809:     }
                   15810:     return;
                   15811: }
                   15812: 
                   15813: =pod
                   15814: 
                   15815: =item * &extract_categories()
                   15816: 
                   15817: Used to generate breadcrumb trails for course categories.
                   15818: 
                   15819: Inputs:
1.663     raeburn  15820: 
1.655     raeburn  15821: categories (reference to hash of category definitions).
1.663     raeburn  15822: 
1.655     raeburn  15823: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   15824:       categories and subcategories).
1.663     raeburn  15825: 
1.655     raeburn  15826: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  15827: 
1.655     raeburn  15828: allitems (reference to hash - key is category key 
                   15829:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  15830: 
1.655     raeburn  15831: idx (reference to hash of counters used in Domain Coordinator interface for
                   15832:       editing Course Categories).
1.663     raeburn  15833: 
1.655     raeburn  15834: jsarray (reference to array of categories used to create Javascript arrays for
                   15835:          Domain Coordinator interface for editing Course Categories).
                   15836: 
1.665     raeburn  15837: subcats (reference to hash of arrays containing all subcategories within each 
                   15838:          category, -recursive)
                   15839: 
1.1075.2.132  raeburn  15840: maxd (reference to hash used to hold max depth for all top-level categories).
                   15841: 
1.655     raeburn  15842: Returns: nothing
                   15843: 
                   15844: Side effects: populates trails and allitems hash references.
                   15845: 
                   15846: =cut
                   15847: 
                   15848: sub extract_categories {
1.1075.2.132  raeburn  15849:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655     raeburn  15850:     if (ref($categories) eq 'HASH') {
                   15851:         &gather_categories($categories,$cats,$idx,$jsarray);
                   15852:         if (ref($cats->[0]) eq 'ARRAY') {
                   15853:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   15854:                 my $name = $cats->[0][$i];
                   15855:                 my $item = &escape($name).'::0';
                   15856:                 my $trailstr;
                   15857:                 if ($name eq 'instcode') {
                   15858:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  15859:                 } elsif ($name eq 'communities') {
                   15860:                     $trailstr = &mt('Communities');
1.655     raeburn  15861:                 } else {
                   15862:                     $trailstr = $name;
                   15863:                 }
                   15864:                 if ($allitems->{$item} eq '') {
                   15865:                     push(@{$trails},$trailstr);
                   15866:                     $allitems->{$item} = scalar(@{$trails})-1;
                   15867:                 }
                   15868:                 my @parents = ($name);
                   15869:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   15870:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   15871:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  15872:                         if (ref($subcats) eq 'HASH') {
                   15873:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   15874:                         }
1.1075.2.132  raeburn  15875:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665     raeburn  15876:                     }
                   15877:                 } else {
                   15878:                     if (ref($subcats) eq 'HASH') {
                   15879:                         $subcats->{$item} = [];
1.655     raeburn  15880:                     }
1.1075.2.132  raeburn  15881:                     if (ref($maxd) eq 'HASH') {
                   15882:                         $maxd->{$name} = 1;
                   15883:                     }
1.655     raeburn  15884:                 }
                   15885:             }
                   15886:         }
                   15887:     }
                   15888:     return;
                   15889: }
                   15890: 
                   15891: =pod
                   15892: 
1.1075.2.56  raeburn  15893: =item * &recurse_categories()
1.655     raeburn  15894: 
                   15895: Recursively used to generate breadcrumb trails for course categories.
                   15896: 
                   15897: Inputs:
1.663     raeburn  15898: 
1.655     raeburn  15899: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   15900:       categories and subcategories).
1.663     raeburn  15901: 
1.655     raeburn  15902: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  15903: 
                   15904: category (current course category, for which breadcrumb trail is being generated).
                   15905: 
                   15906: trails (reference to array of breadcrumb trails for each category).
                   15907: 
1.655     raeburn  15908: allitems (reference to hash - key is category key
                   15909:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  15910: 
1.655     raeburn  15911: parents (array containing containers directories for current category, 
                   15912:          back to top level). 
                   15913: 
                   15914: Returns: nothing
                   15915: 
                   15916: Side effects: populates trails and allitems hash references
                   15917: 
                   15918: =cut
                   15919: 
                   15920: sub recurse_categories {
1.1075.2.132  raeburn  15921:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655     raeburn  15922:     my $shallower = $depth - 1;
                   15923:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   15924:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   15925:             my $name = $cats->[$depth]{$category}[$k];
                   15926:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.161.  .4(raebu 15927:22):             my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  15928:             if ($allitems->{$item} eq '') {
                   15929:                 push(@{$trails},$trailstr);
                   15930:                 $allitems->{$item} = scalar(@{$trails})-1;
                   15931:             }
                   15932:             my $deeper = $depth+1;
                   15933:             push(@{$parents},$category);
1.665     raeburn  15934:             if (ref($subcats) eq 'HASH') {
                   15935:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   15936:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   15937:                     my $higher;
                   15938:                     if ($j > 0) {
                   15939:                         $higher = &escape($parents->[$j]).':'.
                   15940:                                   &escape($parents->[$j-1]).':'.$j;
                   15941:                     } else {
                   15942:                         $higher = &escape($parents->[$j]).'::'.$j;
                   15943:                     }
                   15944:                     push(@{$subcats->{$higher}},$subcat);
                   15945:                 }
                   15946:             }
                   15947:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1075.2.132  raeburn  15948:                                 $subcats,$maxd);
1.655     raeburn  15949:             pop(@{$parents});
                   15950:         }
                   15951:     } else {
                   15952:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.132  raeburn  15953:         my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  15954:         if ($allitems->{$item} eq '') {
                   15955:             push(@{$trails},$trailstr);
                   15956:             $allitems->{$item} = scalar(@{$trails})-1;
                   15957:         }
1.1075.2.132  raeburn  15958:         if (ref($maxd) eq 'HASH') {
                   15959:             if ($depth > $maxd->{$parents->[0]}) {
                   15960:                 $maxd->{$parents->[0]} = $depth;
                   15961:             }
                   15962:         }
1.655     raeburn  15963:     }
                   15964:     return;
                   15965: }
                   15966: 
1.663     raeburn  15967: =pod
                   15968: 
1.1075.2.56  raeburn  15969: =item * &assign_categories_table()
1.663     raeburn  15970: 
                   15971: Create a datatable for display of hierarchical categories in a domain,
                   15972: with checkboxes to allow a course to be categorized. 
                   15973: 
                   15974: Inputs:
                   15975: 
                   15976: cathash - reference to hash of categories defined for the domain (from
                   15977:           configuration.db)
                   15978: 
                   15979: currcat - scalar with an & separated list of categories assigned to a course. 
                   15980: 
1.919     raeburn  15981: type    - scalar contains course type (Course or Community).
                   15982: 
1.1075.2.117  raeburn  15983: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   15984:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   15985: 
1.663     raeburn  15986: Returns: $output (markup to be displayed) 
                   15987: 
                   15988: =cut
                   15989: 
                   15990: sub assign_categories_table {
1.1075.2.117  raeburn  15991:     my ($cathash,$currcat,$type,$disabled) = @_;
1.663     raeburn  15992:     my $output;
                   15993:     if (ref($cathash) eq 'HASH') {
1.1075.2.132  raeburn  15994:         my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
                   15995:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663     raeburn  15996:         $maxdepth = scalar(@cats);
                   15997:         if (@cats > 0) {
                   15998:             my $itemcount = 0;
                   15999:             if (ref($cats[0]) eq 'ARRAY') {
                   16000:                 my @currcategories;
                   16001:                 if ($currcat ne '') {
                   16002:                     @currcategories = split('&',$currcat);
                   16003:                 }
1.919     raeburn  16004:                 my $table;
1.663     raeburn  16005:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   16006:                     my $parent = $cats[0][$i];
1.919     raeburn  16007:                     next if ($parent eq 'instcode');
                   16008:                     if ($type eq 'Community') {
                   16009:                         next unless ($parent eq 'communities');
                   16010:                     } else {
                   16011:                         next if ($parent eq 'communities');
                   16012:                     }
1.663     raeburn  16013:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   16014:                     my $item = &escape($parent).'::0';
                   16015:                     my $checked = '';
                   16016:                     if (@currcategories > 0) {
                   16017:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   16018:                             $checked = ' checked="checked"';
1.663     raeburn  16019:                         }
                   16020:                     }
1.919     raeburn  16021:                     my $parent_title = $parent;
                   16022:                     if ($parent eq 'communities') {
                   16023:                         $parent_title = &mt('Communities');
                   16024:                     }
                   16025:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   16026:                               '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117  raeburn  16027:                               $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919     raeburn  16028:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  16029:                     my $depth = 1;
                   16030:                     push(@path,$parent);
1.1075.2.117  raeburn  16031:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663     raeburn  16032:                     pop(@path);
1.919     raeburn  16033:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  16034:                     $itemcount ++;
                   16035:                 }
1.919     raeburn  16036:                 if ($itemcount) {
                   16037:                     $output = &Apache::loncommon::start_data_table().
                   16038:                               $table.
                   16039:                               &Apache::loncommon::end_data_table();
                   16040:                 }
1.663     raeburn  16041:             }
                   16042:         }
                   16043:     }
                   16044:     return $output;
                   16045: }
                   16046: 
                   16047: =pod
                   16048: 
1.1075.2.56  raeburn  16049: =item * &assign_category_rows()
1.663     raeburn  16050: 
                   16051: Create a datatable row for display of nested categories in a domain,
                   16052: with checkboxes to allow a course to be categorized,called recursively.
                   16053: 
                   16054: Inputs:
                   16055: 
                   16056: itemcount - track row number for alternating colors
                   16057: 
                   16058: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   16059:       categories and subcategories.
                   16060: 
                   16061: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   16062: 
                   16063: parent - parent of current category item
                   16064: 
                   16065: path - Array containing all categories back up through the hierarchy from the
                   16066:        current category to the top level.
                   16067: 
                   16068: currcategories - reference to array of current categories assigned to the course
                   16069: 
1.1075.2.117  raeburn  16070: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   16071:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   16072: 
1.663     raeburn  16073: Returns: $output (markup to be displayed).
                   16074: 
                   16075: =cut
                   16076: 
                   16077: sub assign_category_rows {
1.1075.2.117  raeburn  16078:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663     raeburn  16079:     my ($text,$name,$item,$chgstr);
                   16080:     if (ref($cats) eq 'ARRAY') {
                   16081:         my $maxdepth = scalar(@{$cats});
                   16082:         if (ref($cats->[$depth]) eq 'HASH') {
                   16083:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   16084:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   16085:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  16086:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  16087:                 for (my $j=0; $j<$numchildren; $j++) {
                   16088:                     $name = $cats->[$depth]{$parent}[$j];
                   16089:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   16090:                     my $deeper = $depth+1;
                   16091:                     my $checked = '';
                   16092:                     if (ref($currcategories) eq 'ARRAY') {
                   16093:                         if (@{$currcategories} > 0) {
                   16094:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   16095:                                 $checked = ' checked="checked"';
1.663     raeburn  16096:                             }
                   16097:                         }
                   16098:                     }
1.664     raeburn  16099:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   16100:                              '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117  raeburn  16101:                              $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675     raeburn  16102:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   16103:                              '</td><td>';
1.663     raeburn  16104:                     if (ref($path) eq 'ARRAY') {
                   16105:                         push(@{$path},$name);
1.1075.2.117  raeburn  16106:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663     raeburn  16107:                         pop(@{$path});
                   16108:                     }
                   16109:                     $text .= '</td></tr>';
                   16110:                 }
                   16111:                 $text .= '</table></td>';
                   16112:             }
                   16113:         }
                   16114:     }
                   16115:     return $text;
                   16116: }
                   16117: 
1.1075.2.69  raeburn  16118: =pod
                   16119: 
                   16120: =back
                   16121: 
                   16122: =cut
                   16123: 
1.655     raeburn  16124: ############################################################
                   16125: ############################################################
                   16126: 
                   16127: 
1.443     albertel 16128: sub commit_customrole {
1.664     raeburn  16129:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  16130:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 16131:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   16132:                          ($end?', ending '.localtime($end):'').': <b>'.
                   16133:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  16134:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 16135:                  '</b><br />';
                   16136:     return $output;
                   16137: }
                   16138: 
                   16139: sub commit_standardrole {
1.1075.2.31  raeburn  16140:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  16141:     my ($output,$logmsg,$linefeed);
                   16142:     if ($context eq 'auto') {
                   16143:         $linefeed = "\n";
                   16144:     } else {
                   16145:         $linefeed = "<br />\n";
                   16146:     }  
1.443     albertel 16147:     if ($three eq 'st') {
1.541     raeburn  16148:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  16149:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  16150:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  16151:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   16152:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 16153:         } else {
1.541     raeburn  16154:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 16155:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  16156:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   16157:             if ($context eq 'auto') {
                   16158:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   16159:             } else {
                   16160:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   16161:                &mt('Add to classlist').': <b>ok</b>';
                   16162:             }
                   16163:             $output .= $linefeed;
1.443     albertel 16164:         }
                   16165:     } else {
                   16166:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   16167:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  16168:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  16169:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  16170:         if ($context eq 'auto') {
                   16171:             $output .= $result.$linefeed;
                   16172:         } else {
                   16173:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   16174:         }
1.443     albertel 16175:     }
                   16176:     return $output;
                   16177: }
                   16178: 
                   16179: sub commit_studentrole {
1.1075.2.31  raeburn  16180:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   16181:         $credits) = @_;
1.626     raeburn  16182:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  16183:     if ($context eq 'auto') {
                   16184:         $linefeed = "\n";
                   16185:     } else {
                   16186:         $linefeed = '<br />'."\n";
                   16187:     }
1.443     albertel 16188:     if (defined($one) && defined($two)) {
                   16189:         my $cid=$one.'_'.$two;
                   16190:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   16191:         my $secchange = 0;
                   16192:         my $expire_role_result;
                   16193:         my $modify_section_result;
1.628     raeburn  16194:         if ($oldsec ne '-1') { 
                   16195:             if ($oldsec ne $sec) {
1.443     albertel 16196:                 $secchange = 1;
1.628     raeburn  16197:                 my $now = time;
1.443     albertel 16198:                 my $uurl='/'.$cid;
                   16199:                 $uurl=~s/\_/\//g;
                   16200:                 if ($oldsec) {
                   16201:                     $uurl.='/'.$oldsec;
                   16202:                 }
1.626     raeburn  16203:                 $oldsecurl = $uurl;
1.628     raeburn  16204:                 $expire_role_result = 
1.1075.2.161.  .14(raeb 16205:-23):                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','','',$context);
1.628     raeburn  16206:                 if ($env{'request.course.sec'} ne '') { 
                   16207:                     if ($expire_role_result eq 'refused') {
                   16208:                         my @roles = ('st');
                   16209:                         my @statuses = ('previous');
                   16210:                         my @roledoms = ($one);
                   16211:                         my $withsec = 1;
                   16212:                         my %roleshash = 
                   16213:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   16214:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   16215:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   16216:                             my ($oldstart,$oldend) = 
                   16217:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   16218:                             if ($oldend > 0 && $oldend <= $now) {
                   16219:                                 $expire_role_result = 'ok';
                   16220:                             }
                   16221:                         }
                   16222:                     }
                   16223:                 }
1.443     albertel 16224:                 $result = $expire_role_result;
                   16225:             }
                   16226:         }
                   16227:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  16228:             $modify_section_result = 
                   16229:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   16230:                                                            undef,undef,undef,$sec,
                   16231:                                                            $end,$start,'','',$cid,
                   16232:                                                            '',$context,$credits);
1.443     albertel 16233:             if ($modify_section_result =~ /^ok/) {
                   16234:                 if ($secchange == 1) {
1.628     raeburn  16235:                     if ($sec eq '') {
                   16236:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   16237:                     } else {
                   16238:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   16239:                     }
1.443     albertel 16240:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  16241:                     if ($sec eq '') {
                   16242:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   16243:                     } else {
                   16244:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   16245:                     }
1.443     albertel 16246:                 } else {
1.628     raeburn  16247:                     if ($sec eq '') {
                   16248:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   16249:                     } else {
                   16250:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   16251:                     }
1.443     albertel 16252:                 }
                   16253:             } else {
1.628     raeburn  16254:                 if ($secchange) {       
                   16255:                     $$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;
                   16256:                 } else {
                   16257:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   16258:                 }
1.443     albertel 16259:             }
                   16260:             $result = $modify_section_result;
                   16261:         } elsif ($secchange == 1) {
1.628     raeburn  16262:             if ($oldsec eq '') {
1.1075.2.20  raeburn  16263:                 $$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  16264:             } else {
                   16265:                 $$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;
                   16266:             }
1.626     raeburn  16267:             if ($expire_role_result eq 'refused') {
                   16268:                 my $newsecurl = '/'.$cid;
                   16269:                 $newsecurl =~ s/\_/\//g;
                   16270:                 if ($sec ne '') {
                   16271:                     $newsecurl.='/'.$sec;
                   16272:                 }
                   16273:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   16274:                     if ($sec eq '') {
                   16275:                         $$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;
                   16276:                     } else {
                   16277:                         $$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;
                   16278:                     }
                   16279:                 }
                   16280:             }
1.443     albertel 16281:         }
                   16282:     } else {
1.626     raeburn  16283:         $$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 16284:         $result = "error: incomplete course id\n";
                   16285:     }
                   16286:     return $result;
                   16287: }
                   16288: 
1.1075.2.25  raeburn  16289: sub show_role_extent {
                   16290:     my ($scope,$context,$role) = @_;
                   16291:     $scope =~ s{^/}{};
                   16292:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   16293:     push(@courseroles,'co');
                   16294:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   16295:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   16296:         $scope =~ s{/}{_};
                   16297:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   16298:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   16299:         my ($audom,$auname) = split(/\//,$scope);
                   16300:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   16301:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   16302:     } else {
                   16303:         $scope =~ s{/$}{};
                   16304:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   16305:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   16306:     }
                   16307: }
                   16308: 
1.443     albertel 16309: ############################################################
                   16310: ############################################################
                   16311: 
1.566     albertel 16312: sub check_clone {
1.578     raeburn  16313:     my ($args,$linefeed) = @_;
1.566     albertel 16314:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   16315:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   16316:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1075.2.161.  .1(raebu 16317:21):     my $clonetitle;
                   16318:21):     my @clonemsg;
1.566     albertel 16319:     my $can_clone = 0;
1.944     raeburn  16320:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  16321:     if ($lctype ne 'community') {
                   16322:         $lctype = 'course';
                   16323:     }
1.566     albertel 16324:     if ($clonehome eq 'no_host') {
1.944     raeburn  16325:         if ($args->{'crstype'} eq 'Community') {
1.1075.2.161.  .1(raebu 16326:21):             push(@clonemsg,({
                   16327:21):                               mt => 'No new community created.',
                   16328:21):                               args => [],
                   16329:21):                             },
                   16330:21):                             {
                   16331:21):                               mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
                   16332:21):                               args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
                   16333:21):                             }));
1.908     raeburn  16334:         } else {
1.1075.2.161.  .1(raebu 16335:21):             push(@clonemsg,({
                   16336:21):                               mt => 'No new course created.',
                   16337:21):                               args => [],
                   16338:21):                             },
                   16339:21):                             {
                   16340:21):                               mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
                   16341:21):                               args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                   16342:21):                             }));
                   16343:21):         }
1.566     albertel 16344:     } else {
                   16345: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1075.2.161.  .1(raebu 16346:21):         $clonetitle = $clonedesc{'description'};
1.944     raeburn  16347:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  16348:             if ($clonedesc{'type'} ne 'Community') {
1.1075.2.161.  .1(raebu 16349:21):                 push(@clonemsg,({
                   16350:21):                                   mt => 'No new community created.',
                   16351:21):                                   args => [],
                   16352:21):                                 },
                   16353:21):                                 {
                   16354:21):                                   mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
                   16355:21):                                   args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                   16356:21):                                 }));
                   16357:21):                 return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908     raeburn  16358:             }
                   16359:         }
1.1075.2.119  raeburn  16360: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882     raeburn  16361:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 16362: 	    $can_clone = 1;
                   16363: 	} else {
1.1075.2.95  raeburn  16364: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 16365: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95  raeburn  16366:             if ($clonehash{'cloners'} eq '') {
                   16367:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   16368:                 if ($domdefs{'canclone'}) {
                   16369:                     unless ($domdefs{'canclone'} eq 'none') {
                   16370:                         if ($domdefs{'canclone'} eq 'domain') {
                   16371:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   16372:                                 $can_clone = 1;
                   16373:                             }
                   16374:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   16375:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   16376:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   16377:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   16378:                                 $can_clone = 1;
                   16379:                             }
                   16380:                         }
                   16381:                     }
1.908     raeburn  16382:                 }
1.1075.2.95  raeburn  16383:             } else {
                   16384: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   16385:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  16386:                     $can_clone = 1;
1.1075.2.95  raeburn  16387:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  16388:                     $can_clone = 1;
1.1075.2.96  raeburn  16389:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   16390:                     $can_clone = 1;
1.1075.2.95  raeburn  16391:                 }
                   16392:                 unless ($can_clone) {
1.1075.2.96  raeburn  16393:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   16394:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1075.2.95  raeburn  16395:                         my (%gotdomdefaults,%gotcodedefaults);
                   16396:                         foreach my $cloner (@cloners) {
                   16397:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   16398:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   16399:                                 my (%codedefaults,@code_order);
                   16400:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   16401:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   16402:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   16403:                                     }
                   16404:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   16405:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   16406:                                     }
                   16407:                                 } else {
                   16408:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   16409:                                                                             \%codedefaults,
                   16410:                                                                             \@code_order);
                   16411:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   16412:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   16413:                                 }
                   16414:                                 if (@code_order > 0) {
                   16415:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   16416:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   16417:                                                                                 $args->{'crscode'})) {
                   16418:                                         $can_clone = 1;
                   16419:                                         last;
                   16420:                                     }
                   16421:                                 }
                   16422:                             }
                   16423:                         }
                   16424:                     }
1.1075.2.96  raeburn  16425:                 }
                   16426:             }
                   16427:             unless ($can_clone) {
                   16428:                 my $ccrole = 'cc';
                   16429:                 if ($args->{'crstype'} eq 'Community') {
                   16430:                     $ccrole = 'co';
                   16431:                 }
                   16432:                 my %roleshash =
                   16433:                     &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   16434:                                                   $args->{'ccdomain'},
                   16435:                                                   'userroles',['active'],[$ccrole],
                   16436:                                                   [$args->{'clonedomain'}]);
                   16437:                 if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   16438:                     $can_clone = 1;
                   16439:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   16440:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   16441:                     $can_clone = 1;
1.1075.2.95  raeburn  16442:                 }
                   16443:             }
                   16444:             unless ($can_clone) {
                   16445:                 if ($args->{'crstype'} eq 'Community') {
1.1075.2.161.  .1(raebu 16446:21):                     push(@clonemsg,({
                   16447:21):                                       mt => 'No new community created.',
                   16448:21):                                       args => [],
                   16449:21):                                     },
                   16450:21):                                     {
                   16451:21):                                       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]).',
                   16452:21):                                       args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                   16453:21):                                     }));
1.1075.2.95  raeburn  16454:                 } else {
1.1075.2.161.  .1(raebu 16455:21):                     push(@clonemsg,({
                   16456:21):                                       mt => 'No new course created.',
                   16457:21):                                       args => [],
                   16458:21):                                     },
                   16459:21):                                     {
                   16460:21):                                       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]).',
                   16461:21):                                       args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                   16462:21):                                     }));
1.578     raeburn  16463: 	        }
1.566     albertel 16464: 	    }
1.578     raeburn  16465:         }
1.566     albertel 16466:     }
1.1075.2.161.  .1(raebu 16467:21):     return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566     albertel 16468: }
                   16469: 
1.444     albertel 16470: sub construct_course {
1.1075.2.119  raeburn  16471:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1075.2.161.  .1(raebu 16472:21):         $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
                   16473:21):     my ($outcome,$msgref,$clonemsgref);
1.541     raeburn  16474:     my $linefeed =  '<br />'."\n";
                   16475:     if ($context eq 'auto') {
                   16476:         $linefeed = "\n";
                   16477:     }
1.566     albertel 16478: 
                   16479: #
                   16480: # Are we cloning?
                   16481: #
1.1075.2.161.  .1(raebu 16482:21):     my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566     albertel 16483:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1075.2.161.  .1(raebu 16484:21): 	($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566     albertel 16485:         if (!$can_clone) {
1.1075.2.161.  .1(raebu 16486:21): 	    return (0,$outcome,$clonemsgref);
1.566     albertel 16487: 	}
                   16488:     }
                   16489: 
1.444     albertel 16490: #
                   16491: # Open course
                   16492: #
                   16493:     my $crstype = lc($args->{'crstype'});
                   16494:     my %cenv=();
                   16495:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   16496:                                              $args->{'cdescr'},
                   16497:                                              $args->{'curl'},
                   16498:                                              $args->{'course_home'},
                   16499:                                              $args->{'nonstandard'},
                   16500:                                              $args->{'crscode'},
                   16501:                                              $args->{'ccuname'}.':'.
                   16502:                                              $args->{'ccdomain'},
1.882     raeburn  16503:                                              $args->{'crstype'},
1.1075.2.161.  .1(raebu 16504:21):                                              $cnum,$context,$category,
                   16505:21):                                              $callercontext);
1.444     albertel 16506: 
                   16507:     # Note: The testing routines depend on this being output; see 
                   16508:     # Utils::Course. This needs to at least be output as a comment
                   16509:     # if anyone ever decides to not show this, and Utils::Course::new
                   16510:     # will need to be suitably modified.
1.1075.2.161.  .1(raebu 16511:21):     if (($callercontext eq 'auto') && ($user_lh ne '')) {
                   16512:21):         $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
                   16513:21):     } else {
                   16514:21):         $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
                   16515:21):     }
1.943     raeburn  16516:     if ($$courseid =~ /^error:/) {
1.1075.2.161.  .1(raebu 16517:21):         return (0,$outcome,$clonemsgref);
1.943     raeburn  16518:     }
                   16519: 
1.444     albertel 16520: #
                   16521: # Check if created correctly
                   16522: #
1.479     albertel 16523:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 16524:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  16525:     if ($crsuhome eq 'no_host') {
1.1075.2.161.  .1(raebu 16526:21):         if (($callercontext eq 'auto') && ($user_lh ne '')) {
                   16527:21):             $outcome .= &mt_user($user_lh,
                   16528:21):                             'Course creation failed, unrecognized course home server.');
                   16529:21):         } else {
                   16530:21):             $outcome .= &mt('Course creation failed, unrecognized course home server.');
                   16531:21):         }
                   16532:21):         $outcome .= $linefeed;
                   16533:21):         return (0,$outcome,$clonemsgref);
1.943     raeburn  16534:     }
1.541     raeburn  16535:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 16536: 
1.444     albertel 16537: #
1.566     albertel 16538: # Do the cloning
1.1075.2.161.  .1(raebu 16539:21): #
                   16540:21):     my @clonemsg;
1.566     albertel 16541:     if ($can_clone && $cloneid) {
1.1075.2.161.  .1(raebu 16542:21):         push(@clonemsg,
                   16543:21):                       {
                   16544:21):                           mt => 'Created [_1] by cloning from [_2]',
                   16545:21):                           args => [$crstype,$clonetitle],
                   16546:21):                       });
1.566     albertel 16547: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 16548: # Copy all files
1.1075.2.161.  .1(raebu 16549:21):         my @info =
                   16550:21):             &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
                   16551:21):                                                      $args->{'dateshift'},$args->{'crscode'},
                   16552:21):                                                      $args->{'ccuname'}.':'.$args->{'ccdomain'},
                   16553:21):                                                      $args->{'tinyurls'});
                   16554:21):         if (@info) {
                   16555:21):             push(@clonemsg,@info);
                   16556:21):         }
1.444     albertel 16557: # Restore URL
1.566     albertel 16558: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 16559: # Restore title
1.566     albertel 16560: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  16561: # Restore creation date, creator and creation context.
                   16562:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   16563:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   16564:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 16565: # Mark as cloned
1.566     albertel 16566: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      16567: # Need to clone grading mode
                   16568:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   16569:         $cenv{'grading'}=$newenv{'grading'};
                   16570: # Do not clone these environment entries
                   16571:         &Apache::lonnet::del('environment',
                   16572:                   ['default_enrollment_start_date',
                   16573:                    'default_enrollment_end_date',
                   16574:                    'question.email',
                   16575:                    'policy.email',
                   16576:                    'comment.email',
                   16577:                    'pch.users.denied',
1.725     raeburn  16578:                    'plc.users.denied',
                   16579:                    'hidefromcat',
1.1075.2.36  raeburn  16580:                    'checkforpriv',
1.1075.2.158  raeburn  16581:                    'categories'],
1.638     www      16582:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  16583:         if ($args->{'textbook'}) {
                   16584:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   16585:         }
1.444     albertel 16586:     }
1.566     albertel 16587: 
1.444     albertel 16588: #
                   16589: # Set environment (will override cloned, if existing)
                   16590: #
                   16591:     my @sections = ();
                   16592:     my @xlists = ();
                   16593:     if ($args->{'crstype'}) {
                   16594:         $cenv{'type'}=$args->{'crstype'};
                   16595:     }
1.1075.2.161.  .17(raeb 16596:-23):     if ($args->{'lti'}) {
                   16597:-23):         $cenv{'internal.lti'}=$args->{'lti'};
                   16598:-23):     }
1.444     albertel 16599:     if ($args->{'crsid'}) {
                   16600:         $cenv{'courseid'}=$args->{'crsid'};
                   16601:     }
                   16602:     if ($args->{'crscode'}) {
                   16603:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   16604:     }
                   16605:     if ($args->{'crsquota'} ne '') {
                   16606:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   16607:     } else {
                   16608:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   16609:     }
                   16610:     if ($args->{'ccuname'}) {
                   16611:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   16612:                                         ':'.$args->{'ccdomain'};
                   16613:     } else {
                   16614:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   16615:     }
1.1075.2.31  raeburn  16616:     if ($args->{'defaultcredits'}) {
                   16617:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   16618:     }
1.444     albertel 16619:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.1075.2.161.  .20(raeb 16620:-23):     my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
1.444     albertel 16621:     if ($args->{'crssections'}) {
                   16622:         $cenv{'internal.sectionnums'} = '';
                   16623:         if ($args->{'crssections'} =~ m/,/) {
                   16624:             @sections = split/,/,$args->{'crssections'};
                   16625:         } else {
                   16626:             $sections[0] = $args->{'crssections'};
                   16627:         }
                   16628:         if (@sections > 0) {
                   16629:             foreach my $item (@sections) {
                   16630:                 my ($sec,$gp) = split/:/,$item;
                   16631:                 my $class = $args->{'crscode'}.$sec;
                   16632:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   16633:                 $cenv{'internal.sectionnums'} .= $item.',';
1.1075.2.161.  .20(raeb 16634:-23):                 if ($addcheck eq 'ok') {
                   16635:-23):                     unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
                   16636:-23):                         push(@oklcsecs,$gp);
                   16637:-23):                     }
                   16638:-23):                 } else {
1.1075.2.119  raeburn  16639:                     push(@badclasses,$class);
1.444     albertel 16640:                 }
                   16641:             }
                   16642:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   16643:         }
                   16644:     }
                   16645: # do not hide course coordinator from staff listing, 
                   16646: # even if privileged
                   16647:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  16648: # add course coordinator's domain to domains to check for privileged users
                   16649: # if different to course domain
                   16650:     if ($$crsudom ne $args->{'ccdomain'}) {
                   16651:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   16652:     }
1.444     albertel 16653: # add crosslistings
                   16654:     if ($args->{'crsxlist'}) {
                   16655:         $cenv{'internal.crosslistings'}='';
                   16656:         if ($args->{'crsxlist'} =~ m/,/) {
                   16657:             @xlists = split/,/,$args->{'crsxlist'};
                   16658:         } else {
                   16659:             $xlists[0] = $args->{'crsxlist'};
                   16660:         }
                   16661:         if (@xlists > 0) {
                   16662:             foreach my $item (@xlists) {
                   16663:                 my ($xl,$gp) = split/:/,$item;
                   16664:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   16665:                 $cenv{'internal.crosslistings'} .= $item.',';
1.1075.2.161.  .20(raeb 16666:-23):                 if ($addcheck eq 'ok') {
                   16667:-23):                     unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
                   16668:-23):                         push(@oklcsecs,$gp);
                   16669:-23):                     }
                   16670:-23):                 } else {
1.1075.2.119  raeburn  16671:                     push(@badclasses,$xl);
1.444     albertel 16672:                 }
                   16673:             }
                   16674:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   16675:         }
                   16676:     }
                   16677:     if ($args->{'autoadds'}) {
                   16678:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   16679:     }
                   16680:     if ($args->{'autodrops'}) {
                   16681:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   16682:     }
                   16683: # check for notification of enrollment changes
                   16684:     my @notified = ();
                   16685:     if ($args->{'notify_owner'}) {
                   16686:         if ($args->{'ccuname'} ne '') {
                   16687:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   16688:         }
                   16689:     }
                   16690:     if ($args->{'notify_dc'}) {
                   16691:         if ($uname ne '') { 
1.630     raeburn  16692:             push(@notified,$uname.':'.$udom);
1.444     albertel 16693:         }
                   16694:     }
                   16695:     if (@notified > 0) {
                   16696:         my $notifylist;
                   16697:         if (@notified > 1) {
                   16698:             $notifylist = join(',',@notified);
                   16699:         } else {
                   16700:             $notifylist = $notified[0];
                   16701:         }
                   16702:         $cenv{'internal.notifylist'} = $notifylist;
                   16703:     }
                   16704:     if (@badclasses > 0) {
                   16705:         my %lt=&Apache::lonlocal::texthash(
1.1075.2.119  raeburn  16706:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                   16707:                 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                   16708:                 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444     albertel 16709:         );
1.1075.2.119  raeburn  16710:         my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                   16711:                            &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  16712:         if ($context eq 'auto') {
                   16713:             $outcome .= $badclass_msg.$linefeed;
1.1075.2.119  raeburn  16714:         } else {
1.566     albertel 16715:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1075.2.119  raeburn  16716:         }
                   16717:         foreach my $item (@badclasses) {
1.541     raeburn  16718:             if ($context eq 'auto') {
1.1075.2.119  raeburn  16719:                 $outcome .= " - $item\n";
1.541     raeburn  16720:             } else {
1.1075.2.119  raeburn  16721:                 $outcome .= "<li>$item</li>\n";
1.541     raeburn  16722:             }
1.1075.2.119  raeburn  16723:         }
                   16724:         if ($context eq 'auto') {
                   16725:             $outcome .= $linefeed;
                   16726:         } else {
                   16727:             $outcome .= "</ul><br /><br /></div>\n";
                   16728:         }
1.444     albertel 16729:     }
                   16730:     if ($args->{'no_end_date'}) {
                   16731:         $args->{'endaccess'} = 0;
                   16732:     }
1.1075.2.161.  .20(raeb 16733:-23): #  If an official course with institutional sections is created by cloning
                   16734:-23): #  an existing course, section-specific hiding of course totals in student's
                   16735:-23): #  view of grades as copied from cloned course, will be checked for valid
                   16736:-23): #  sections.
                   16737:-23):     if (($can_clone && $cloneid) &&
                   16738:-23):         ($cenv{'internal.coursecode'} ne '') &&
                   16739:-23):         ($cenv{'grading'} eq 'standard') &&
                   16740:-23):         ($cenv{'hidetotals'} ne '') &&
                   16741:-23):         ($cenv{'hidetotals'} ne 'all')) {
                   16742:-23):         my @hidesecs;
                   16743:-23):         my $deletehidetotals;
                   16744:-23):         if (@oklcsecs) {
                   16745:-23):             foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
                   16746:-23):                 if (grep(/^\Q$sec$/,@oklcsecs)) {
                   16747:-23):                     push(@hidesecs,$sec);
                   16748:-23):                 }
                   16749:-23):             }
                   16750:-23):             if (@hidesecs) {
                   16751:-23):                 $cenv{'hidetotals'} = join(',',@hidesecs);
                   16752:-23):             } else {
                   16753:-23):                 $deletehidetotals = 1;
                   16754:-23):             }
                   16755:-23):         } else {
                   16756:-23):             $deletehidetotals = 1;
                   16757:-23):         }
                   16758:-23):         if ($deletehidetotals) {
                   16759:-23):             delete($cenv{'hidetotals'});
                   16760:-23):             &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
                   16761:-23):         }
                   16762:-23):     }
1.444     albertel 16763:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   16764:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   16765:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   16766:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   16767:     if ($args->{'showphotos'}) {
                   16768:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   16769:     }
                   16770:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   16771:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   16772:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   16773:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  16774:             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'); 
                   16775:             if ($context eq 'auto') {
                   16776:                 $outcome .= $krb_msg;
                   16777:             } else {
1.566     albertel 16778:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  16779:             }
                   16780:             $outcome .= $linefeed;
1.444     albertel 16781:         }
                   16782:     }
                   16783:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   16784:        if ($args->{'setpolicy'}) {
                   16785:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   16786:        }
                   16787:        if ($args->{'setcontent'}) {
                   16788:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   16789:        }
1.1075.2.110  raeburn  16790:        if ($args->{'setcomment'}) {
                   16791:            $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   16792:        }
1.444     albertel 16793:     }
                   16794:     if ($args->{'reshome'}) {
                   16795: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   16796: 	$cenv{'reshome'}=~s/\/+$/\//;
                   16797:     }
                   16798: #
                   16799: # course has keyed access
                   16800: #
                   16801:     if ($args->{'setkeys'}) {
                   16802:        $cenv{'keyaccess'}='yes';
                   16803:     }
                   16804: # if specified, key authority is not course, but user
                   16805: # only active if keyaccess is yes
                   16806:     if ($args->{'keyauth'}) {
1.487     albertel 16807: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   16808: 	$user = &LONCAPA::clean_username($user);
                   16809: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     16810: 	if ($user ne '' && $domain ne '') {
1.487     albertel 16811: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 16812: 	}
                   16813:     }
                   16814: 
1.1075.2.59  raeburn  16815: #
                   16816: #  generate and store uniquecode (available to course requester), if course should have one.
                   16817: #
                   16818:     if ($args->{'uniquecode'}) {
                   16819:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   16820:         if ($code) {
                   16821:             $cenv{'internal.uniquecode'} = $code;
                   16822:             my %crsinfo =
                   16823:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   16824:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   16825:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   16826:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   16827:             }
                   16828:             if (ref($coderef)) {
                   16829:                 $$coderef = $code;
                   16830:             }
                   16831:         }
                   16832:     }
                   16833: 
1.444     albertel 16834:     if ($args->{'disresdis'}) {
                   16835:         $cenv{'pch.roles.denied'}='st';
                   16836:     }
                   16837:     if ($args->{'disablechat'}) {
                   16838:         $cenv{'plc.roles.denied'}='st';
                   16839:     }
                   16840: 
                   16841:     # Record we've not yet viewed the Course Initialization Helper for this 
                   16842:     # course
                   16843:     $cenv{'course.helper.not.run'} = 1;
                   16844:     #
                   16845:     # Use new Randomseed
                   16846:     #
                   16847:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   16848:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   16849:     #
                   16850:     # The encryption code and receipt prefix for this course
                   16851:     #
                   16852:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   16853:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   16854:     #
                   16855:     # By default, use standard grading
                   16856:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   16857: 
1.541     raeburn  16858:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   16859:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 16860: #
                   16861: # Open all assignments
                   16862: #
                   16863:     if ($args->{'openall'}) {
1.1075.2.146  raeburn  16864:        my $opendate = time;
                   16865:        if ($args->{'openallfrom'} =~ /^\d+$/) {
                   16866:            $opendate = $args->{'openallfrom'};
                   16867:        }
1.444     albertel 16868:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1075.2.146  raeburn  16869:        my %storecontent = ($storeunder         => $opendate,
1.444     albertel 16870:                            $storeunder.'.type' => 'date_start');
1.1075.2.146  raeburn  16871:        $outcome .= &mt('All assignments open starting [_1]',
                   16872:                        &Apache::lonlocal::locallocaltime($opendate)).': '.
                   16873:                    &Apache::lonnet::cput
                   16874:                        ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 16875:    }
                   16876: #
                   16877: # Set first page
                   16878: #
                   16879:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   16880: 	    || ($cloneid)) {
                   16881: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 16882: 
                   16883: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   16884:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   16885: 
1.444     albertel 16886:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   16887:         my $title; my $url;
                   16888:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   16889: 	    $title=&mt('Syllabus');
1.444     albertel 16890:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   16891:         } else {
1.963     raeburn  16892:             $title=&mt('Table of Contents');
1.444     albertel 16893:             $url='/adm/navmaps';
                   16894:         }
1.445     albertel 16895: 
                   16896:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   16897: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   16898: 
                   16899: 	if ($errtext) { $fatal=2; }
1.541     raeburn  16900:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 16901:     }
1.566     albertel 16902: 
1.1075.2.161.  .1(raebu 16903:21):     return (1,$outcome,\@clonemsg);
1.444     albertel 16904: }
                   16905: 
1.1075.2.59  raeburn  16906: sub make_unique_code {
                   16907:     my ($cdom,$cnum) = @_;
                   16908:     # get lock on uniquecodes db
                   16909:     my $lockhash = {
                   16910:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   16911:                                                   ':'.$env{'user.domain'},
                   16912:                    };
                   16913:     my $tries = 0;
                   16914:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   16915:     my ($code,$error);
                   16916: 
                   16917:     while (($gotlock ne 'ok') && ($tries<3)) {
                   16918:         $tries ++;
                   16919:         sleep 1;
                   16920:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   16921:     }
                   16922:     if ($gotlock eq 'ok') {
                   16923:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   16924:         my $gotcode;
                   16925:         my $attempts = 0;
                   16926:         while ((!$gotcode) && ($attempts < 100)) {
                   16927:             $code = &generate_code();
                   16928:             if (!exists($currcodes{$code})) {
                   16929:                 $gotcode = 1;
                   16930:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   16931:                     $error = 'nostore';
                   16932:                 }
                   16933:             }
                   16934:             $attempts ++;
                   16935:         }
                   16936:         my @del_lock = ($cnum."\0".'uniquecodes');
                   16937:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   16938:     } else {
                   16939:         $error = 'nolock';
                   16940:     }
                   16941:     return ($code,$error);
                   16942: }
                   16943: 
                   16944: sub generate_code {
                   16945:     my $code;
                   16946:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   16947:     for (my $i=0; $i<6; $i++) {
                   16948:         my $lettnum = int (rand 2);
                   16949:         my $item = '';
                   16950:         if ($lettnum) {
                   16951:             $item = $letts[int( rand(18) )];
                   16952:         } else {
                   16953:             $item = 1+int( rand(8) );
                   16954:         }
                   16955:         $code .= $item;
                   16956:     }
                   16957:     return $code;
                   16958: }
                   16959: 
1.444     albertel 16960: ############################################################
                   16961: ############################################################
                   16962: 
1.953     droeschl 16963: #SD
                   16964: # only Community and Course, or anything else?
1.378     raeburn  16965: sub course_type {
                   16966:     my ($cid) = @_;
                   16967:     if (!defined($cid)) {
                   16968:         $cid = $env{'request.course.id'};
                   16969:     }
1.404     albertel 16970:     if (defined($env{'course.'.$cid.'.type'})) {
                   16971:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  16972:     } else {
                   16973:         return 'Course';
1.377     raeburn  16974:     }
                   16975: }
1.156     albertel 16976: 
1.406     raeburn  16977: sub group_term {
                   16978:     my $crstype = &course_type();
                   16979:     my %names = (
                   16980:                   'Course' => 'group',
1.865     raeburn  16981:                   'Community' => 'group',
1.406     raeburn  16982:                 );
                   16983:     return $names{$crstype};
                   16984: }
                   16985: 
1.902     raeburn  16986: sub course_types {
1.1075.2.161.  .17(raeb 16987:-23):     my @types = ('official','unofficial','community','textbook','lti');
1.902     raeburn  16988:     my %typename = (
                   16989:                          official   => 'Official course',
                   16990:                          unofficial => 'Unofficial course',
                   16991:                          community  => 'Community',
1.1075.2.59  raeburn  16992:                          textbook   => 'Textbook course',
1.1075.2.161.  .17(raeb 16993:-23):                          lti        => 'LTI provider',
1.902     raeburn  16994:                    );
                   16995:     return (\@types,\%typename);
                   16996: }
                   16997: 
1.156     albertel 16998: sub icon {
                   16999:     my ($file)=@_;
1.505     albertel 17000:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 17001:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 17002:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 17003:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   17004: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   17005: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   17006: 	            $curfext.".gif") {
                   17007: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   17008: 		$curfext.".gif";
                   17009: 	}
                   17010:     }
1.249     albertel 17011:     return &lonhttpdurl($iconname);
1.154     albertel 17012: } 
1.84      albertel 17013: 
1.575     albertel 17014: sub lonhttpdurl {
1.692     www      17015: #
                   17016: # Had been used for "small fry" static images on separate port 8080.
                   17017: # Modify here if lightweight http functionality desired again.
                   17018: # Currently eliminated due to increasing firewall issues.
                   17019: #
1.575     albertel 17020:     my ($url)=@_;
1.692     www      17021:     return $url;
1.215     albertel 17022: }
                   17023: 
1.213     albertel 17024: sub connection_aborted {
                   17025:     my ($r)=@_;
                   17026:     $r->print(" ");$r->rflush();
                   17027:     my $c = $r->connection;
                   17028:     return $c->aborted();
                   17029: }
                   17030: 
1.221     foxr     17031: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     17032: #    strings as 'strings'.
                   17033: sub escape_single {
1.221     foxr     17034:     my ($input) = @_;
1.223     albertel 17035:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     17036:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   17037:     return $input;
                   17038: }
1.223     albertel 17039: 
1.222     foxr     17040: #  Same as escape_single, but escape's "'s  This 
                   17041: #  can be used for  "strings"
                   17042: sub escape_double {
                   17043:     my ($input) = @_;
                   17044:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   17045:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   17046:     return $input;
                   17047: }
1.223     albertel 17048:  
1.222     foxr     17049: #   Escapes the last element of a full URL.
                   17050: sub escape_url {
                   17051:     my ($url)   = @_;
1.238     raeburn  17052:     my @urlslices = split(/\//, $url,-1);
1.369     www      17053:     my $lastitem = &escape(pop(@urlslices));
1.1075.2.83  raeburn  17054:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     17055: }
1.462     albertel 17056: 
1.820     raeburn  17057: sub compare_arrays {
                   17058:     my ($arrayref1,$arrayref2) = @_;
                   17059:     my (@difference,%count);
                   17060:     @difference = ();
                   17061:     %count = ();
                   17062:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   17063:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   17064:         foreach my $element (keys(%count)) {
                   17065:             if ($count{$element} == 1) {
                   17066:                 push(@difference,$element);
                   17067:             }
                   17068:         }
                   17069:     }
                   17070:     return @difference;
                   17071: }
                   17072: 
1.1075.2.152  raeburn  17073: sub lon_status_items {
                   17074:     my %defaults = (
                   17075:                      E         => 100,
                   17076:                      W         => 4,
                   17077:                      N         => 1,
                   17078:                      U         => 5,
                   17079:                      threshold => 200,
                   17080:                      sysmail   => 2500,
                   17081:                    );
                   17082:     my %names = (
                   17083:                    E => 'Errors',
                   17084:                    W => 'Warnings',
                   17085:                    N => 'Notices',
                   17086:                    U => 'Unsent',
                   17087:                 );
                   17088:     return (\%defaults,\%names);
                   17089: }
                   17090: 
1.817     bisitz   17091: # -------------------------------------------------------- Initialize user login
1.462     albertel 17092: sub init_user_environment {
1.463     albertel 17093:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 17094:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   17095: 
                   17096:     my $public=($username eq 'public' && $domain eq 'public');
                   17097: 
                   17098: # See if old ID present, if so, remove
                   17099: 
1.1075.2.161.  .22(raeb 17100:-24):     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
                   17101:-24):         $coauthorenv);
1.462     albertel 17102:     my $now=time;
                   17103: 
                   17104:     if ($public) {
                   17105: 	my $max_public=100;
                   17106: 	my $oldest;
                   17107: 	my $oldest_time=0;
                   17108: 	for(my $next=1;$next<=$max_public;$next++) {
                   17109: 	    if (-e $lonids."/publicuser_$next.id") {
                   17110: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   17111: 		if ($mtime<$oldest_time || !$oldest_time) {
                   17112: 		    $oldest_time=$mtime;
                   17113: 		    $oldest=$next;
                   17114: 		}
                   17115: 	    } else {
                   17116: 		$cookie="publicuser_$next";
                   17117: 		last;
                   17118: 	    }
                   17119: 	}
                   17120: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   17121:     } else {
1.463     albertel 17122: 	# if this isn't a robot, kill any existing non-robot sessions
                   17123: 	if (!$args->{'robot'}) {
                   17124: 	    opendir(DIR,$lonids);
                   17125: 	    while ($filename=readdir(DIR)) {
                   17126: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1075.2.136  raeburn  17127:                     if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
                   17128:                             &GDBM_READER(),0640)) {
                   17129:                         my $linkedfile;
                   17130:                         if (exists($oldenv{'user.linkedenv'})) {
                   17131:                             $linkedfile = $oldenv{'user.linkedenv'};
                   17132:                         }
                   17133:                         untie(%oldenv);
                   17134:                         if (unlink("$lonids/$filename")) {
                   17135:                             if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                   17136:                                 if (-l "$lonids/$linkedfile.id") {
                   17137:                                     unlink("$lonids/$linkedfile.id");
                   17138:                                 }
                   17139:                             }
                   17140:                         }
                   17141:                     } else {
                   17142:                         unlink($lonids.'/'.$filename);
                   17143:                     }
1.463     albertel 17144: 		}
1.462     albertel 17145: 	    }
1.463     albertel 17146: 	    closedir(DIR);
1.1075.2.84  raeburn  17147: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   17148:             my $namespace = 'nohist_courseeditor';
                   17149:             my $lockingkey = 'paste'."\0".'locked_num';
                   17150:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   17151:                                                 $domain,$username);
                   17152:             if (exists($lockhash{$lockingkey})) {
                   17153:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   17154:                 unless ($delresult eq 'ok') {
                   17155:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   17156:                 }
                   17157:             }
1.462     albertel 17158: 	}
                   17159: # Give them a new cookie
1.463     albertel 17160: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      17161: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 17162: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 17163:     
                   17164: # Initialize roles
                   17165: 
1.1075.2.161.  .22(raeb 17166:-24): 	($userroles,$firstaccenv,$timerintenv,$coauthorenv) = 
1.1062    raeburn  17167:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 17168:     }
                   17169: # ------------------------------------ Check browser type and MathML capability
                   17170: 
1.1075.2.77  raeburn  17171:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   17172:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 17173: 
                   17174: # ------------------------------------------------------------- Get environment
                   17175: 
                   17176:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   17177:     my ($tmp) = keys(%userenv);
                   17178:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   17179:     } else {
                   17180: 	undef(%userenv);
                   17181:     }
                   17182:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   17183: 	$form->{'interface'}=$userenv{'interface'};
                   17184:     }
                   17185:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   17186: 
                   17187: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   17188:     foreach my $option ('interface','localpath','localres') {
                   17189:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 17190:     }
                   17191: # --------------------------------------------------------- Write first profile
                   17192: 
                   17193:     {
1.1075.2.150  raeburn  17194:         my $ip = &Apache::lonnet::get_requestor_ip();
1.462     albertel 17195: 	my %initial_env = 
                   17196: 	    ("user.name"          => $username,
                   17197: 	     "user.domain"        => $domain,
                   17198: 	     "user.home"          => $authhost,
                   17199: 	     "browser.type"       => $clientbrowser,
                   17200: 	     "browser.version"    => $clientversion,
                   17201: 	     "browser.mathml"     => $clientmathml,
                   17202: 	     "browser.unicode"    => $clientunicode,
                   17203: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  17204:              "browser.mobile"     => $clientmobile,
                   17205:              "browser.info"       => $clientinfo,
1.1075.2.77  raeburn  17206:              "browser.osversion"  => $clientosversion,
1.462     albertel 17207: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   17208: 	     "request.course.fn"  => '',
                   17209: 	     "request.course.uri" => '',
                   17210: 	     "request.course.sec" => '',
                   17211: 	     "request.role"       => 'cm',
                   17212: 	     "request.role.adv"   => $env{'user.adv'},
1.1075.2.150  raeburn  17213: 	     "request.host"       => $ip,);
1.462     albertel 17214: 
                   17215:         if ($form->{'localpath'}) {
                   17216: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   17217: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   17218:         }
                   17219: 	
                   17220: 	if ($form->{'interface'}) {
                   17221: 	    $form->{'interface'}=~s/\W//gs;
                   17222: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   17223: 	    $env{'browser.interface'}=$form->{'interface'};
                   17224: 	}
                   17225: 
1.1075.2.54  raeburn  17226:         if ($form->{'iptoken'}) {
                   17227:             my $lonhost = $r->dir_config('lonHostID');
                   17228:             $initial_env{"user.noloadbalance"} = $lonhost;
                   17229:             $env{'user.noloadbalance'} = $lonhost;
                   17230:         }
                   17231: 
1.1075.2.120  raeburn  17232:         if ($form->{'noloadbalance'}) {
                   17233:             my @hosts = &Apache::lonnet::current_machine_ids();
                   17234:             my $hosthere = $form->{'noloadbalance'};
                   17235:             if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   17236:                 $initial_env{"user.noloadbalance"} = $hosthere;
                   17237:                 $env{'user.noloadbalance'} = $hosthere;
                   17238:             }
                   17239:         }
                   17240: 
1.1016    raeburn  17241:         unless ($domain eq 'public') {
1.1075.2.125  raeburn  17242:             my %is_adv = ( is_adv => $env{'user.adv'} );
                   17243:             my %domdef = &Apache::lonnet::get_domain_defaults($domain);
1.980     raeburn  17244: 
1.1075.2.161.  .10(raeb 17245:-22):             foreach my $tool ('aboutme','blog','webdav','portfolio','timezone') {
1.1075.2.125  raeburn  17246:                 $userenv{'availabletools.'.$tool} = 
                   17247:                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   17248:                                                       undef,\%userenv,\%domdef,\%is_adv);
                   17249:             }
1.724     raeburn  17250: 
1.1075.2.161.  .17(raeb 17251:-23):             foreach my $crstype ('official','unofficial','community','textbook','lti') {
1.1075.2.125  raeburn  17252:                 $userenv{'canrequest.'.$crstype} =
                   17253:                     &Apache::lonnet::usertools_access($username,$domain,$crstype,
                   17254:                                                       'reload','requestcourses',
                   17255:                                                       \%userenv,\%domdef,\%is_adv);
                   17256:             }
1.765     raeburn  17257: 
1.1075.2.161.  .21(raeb 17258:-24):             if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
                   17259:-24):                 (exists($userroles->{"user.role.au./$domain/"}))) {
                   17260:-24):                 if ($userenv{'authoreditors'}) {
                   17261:-24):                     $userenv{'editors'} = $userenv{'authoreditors'};
                   17262:-24):                 } elsif ($domdef{'editors'} ne '') {
                   17263:-24):                     $userenv{'editors'} = $domdef{'editors'};
                   17264:-24):                 } else {
                   17265:-24):                     $userenv{'editors'} = 'edit,xml';
                   17266:-24):                 }
                   17267:-24):             }
                   17268:-24): 
1.1075.2.125  raeburn  17269:             $userenv{'canrequest.author'} =
                   17270:                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   17271:                                                   'reload','requestauthor',
                   17272:                                                   \%userenv,\%domdef,\%is_adv);
                   17273:             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   17274:                                                  $domain,$username);
                   17275:             my $reqstatus = $reqauthor{'author_status'};
                   17276:             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   17277:                 if (ref($reqauthor{'author'}) eq 'HASH') {
                   17278:                     $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   17279:                                                       $reqauthor{'author'}{'timestamp'};
                   17280:                 }
1.1075.2.14  raeburn  17281:             }
                   17282:         }
                   17283: 
1.462     albertel 17284: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  17285: 
1.462     albertel 17286: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   17287: 		 &GDBM_WRCREAT(),0640)) {
                   17288: 	    &_add_to_env(\%disk_env,\%initial_env);
                   17289: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   17290: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  17291:             if (ref($firstaccenv) eq 'HASH') {
                   17292:                 &_add_to_env(\%disk_env,$firstaccenv);
                   17293:             }
                   17294:             if (ref($timerintenv) eq 'HASH') {
                   17295:                 &_add_to_env(\%disk_env,$timerintenv);
                   17296:             }
1.1075.2.161.  .22(raeb 17297:-24):             if (ref($coauthorenv) eq 'HASH') {
                   17298:-24):                 if (keys(%{$coauthorenv})) {
                   17299:-24):                     &_add_to_env(\%disk_env,$coauthorenv);
                   17300:-24):                 }
                   17301:-24):             }
1.463     albertel 17302: 	    if (ref($args->{'extra_env'})) {
                   17303: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   17304: 	    }
1.462     albertel 17305: 	    untie(%disk_env);
                   17306: 	} else {
1.705     tempelho 17307: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   17308: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 17309: 	    return 'error: '.$!;
                   17310: 	}
                   17311:     }
                   17312:     $env{'request.role'}='cm';
                   17313:     $env{'request.role.adv'}=$env{'user.adv'};
                   17314:     $env{'browser.type'}=$clientbrowser;
                   17315: 
                   17316:     return $cookie;
                   17317: 
                   17318: }
                   17319: 
                   17320: sub _add_to_env {
                   17321:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  17322:     if (ref($env_data) eq 'HASH') {
                   17323:         while (my ($key,$value) = each(%$env_data)) {
                   17324: 	    $idf->{$prefix.$key} = $value;
                   17325: 	    $env{$prefix.$key}   = $value;
                   17326:         }
1.462     albertel 17327:     }
                   17328: }
                   17329: 
1.685     tempelho 17330: # --- Get the symbolic name of a problem and the url
                   17331: sub get_symb {
                   17332:     my ($request,$silent) = @_;
1.726     raeburn  17333:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 17334:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   17335:     if ($symb eq '') {
                   17336:         if (!$silent) {
1.1071    raeburn  17337:             if (ref($request)) { 
                   17338:                 $request->print("Unable to handle ambiguous references:$url:.");
                   17339:             }
1.685     tempelho 17340:             return ();
                   17341:         }
                   17342:     }
                   17343:     &Apache::lonenc::check_decrypt(\$symb);
                   17344:     return ($symb);
                   17345: }
                   17346: 
                   17347: # --------------------------------------------------------------Get annotation
                   17348: 
                   17349: sub get_annotation {
                   17350:     my ($symb,$enc) = @_;
                   17351: 
                   17352:     my $key = $symb;
                   17353:     if (!$enc) {
                   17354:         $key =
                   17355:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   17356:     }
                   17357:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   17358:     return $annotation{$key};
                   17359: }
                   17360: 
                   17361: sub clean_symb {
1.731     raeburn  17362:     my ($symb,$delete_enc) = @_;
1.685     tempelho 17363: 
                   17364:     &Apache::lonenc::check_decrypt(\$symb);
                   17365:     my $enc = $env{'request.enc'};
1.731     raeburn  17366:     if ($delete_enc) {
1.730     raeburn  17367:         delete($env{'request.enc'});
                   17368:     }
1.685     tempelho 17369: 
                   17370:     return ($symb,$enc);
                   17371: }
1.462     albertel 17372: 
1.1075.2.69  raeburn  17373: ############################################################
                   17374: ############################################################
                   17375: 
                   17376: =pod
                   17377: 
                   17378: =head1 Routines for building display used to search for courses
                   17379: 
                   17380: 
                   17381: =over 4
                   17382: 
                   17383: =item * &build_filters()
                   17384: 
                   17385: Create markup for a table used to set filters to use when selecting
                   17386: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   17387: and quotacheck.pl
                   17388: 
                   17389: 
                   17390: Inputs:
                   17391: 
                   17392: filterlist - anonymous array of fields to include as potential filters
                   17393: 
                   17394: crstype - course type
                   17395: 
                   17396: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   17397:               to pop-open a course selector (will contain "extra element").
                   17398: 
                   17399: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   17400: 
                   17401: filter - anonymous hash of criteria and their values
                   17402: 
                   17403: action - form action
                   17404: 
                   17405: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   17406: 
                   17407: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   17408: 
                   17409: cloneruname - username of owner of new course who wants to clone
                   17410: 
                   17411: clonerudom - domain of owner of new course who wants to clone
                   17412: 
                   17413: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   17414: 
                   17415: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   17416: 
                   17417: codedom - domain
                   17418: 
                   17419: formname - value of form element named "form".
                   17420: 
                   17421: fixeddom - domain, if fixed.
                   17422: 
                   17423: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   17424: 
                   17425: cnameelement - name of form element in form on opener page which will receive title of selected course
                   17426: 
                   17427: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   17428: 
                   17429: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   17430: 
                   17431: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   17432: 
                   17433: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   17434: 
                   17435: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   17436: 
                   17437: 
                   17438: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   17439: 
                   17440: 
                   17441: Side Effects: None
                   17442: 
                   17443: =cut
                   17444: 
                   17445: # ---------------------------------------------- search for courses based on last activity etc.
                   17446: 
                   17447: sub build_filters {
                   17448:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   17449:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   17450:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   17451:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   17452:         $clonetext,$clonewarning) = @_;
                   17453:     my ($list,$jscript);
                   17454:     my $onchange = 'javascript:updateFilters(this)';
                   17455:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   17456:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   17457:         $typeselectform,$instcodetitle);
                   17458:     if ($formname eq '') {
                   17459:         $formname = $caller;
                   17460:     }
                   17461:     foreach my $item (@{$filterlist}) {
                   17462:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   17463:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   17464:             if ($item eq 'domainfilter') {
                   17465:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   17466:             } elsif ($item eq 'coursefilter') {
                   17467:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   17468:             } elsif ($item eq 'ownerfilter') {
                   17469:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   17470:             } elsif ($item eq 'ownerdomfilter') {
                   17471:                 $filter->{'ownerdomfilter'} =
                   17472:                     &LONCAPA::clean_domain($filter->{$item});
                   17473:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   17474:                                                        'ownerdomfilter',1);
                   17475:             } elsif ($item eq 'personfilter') {
                   17476:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   17477:             } elsif ($item eq 'persondomfilter') {
                   17478:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   17479:                                                         'persondomfilter',1);
                   17480:             } else {
                   17481:                 $filter->{$item} =~ s/\W//g;
                   17482:             }
                   17483:             if (!$filter->{$item}) {
                   17484:                 $filter->{$item} = '';
                   17485:             }
                   17486:         }
                   17487:         if ($item eq 'domainfilter') {
                   17488:             my $allow_blank = 1;
                   17489:             if ($formname eq 'portform') {
                   17490:                 $allow_blank=0;
                   17491:             } elsif ($formname eq 'studentform') {
                   17492:                 $allow_blank=0;
                   17493:             }
                   17494:             if ($fixeddom) {
                   17495:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   17496:                                     ' value="'.$codedom.'" />'.
                   17497:                                     &Apache::lonnet::domain($codedom,'description');
                   17498:             } else {
                   17499:                 $domainselectform = &select_dom_form($filter->{$item},
                   17500:                                                      'domainfilter',
                   17501:                                                       $allow_blank,'',$onchange);
                   17502:             }
                   17503:         } else {
                   17504:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   17505:         }
                   17506:     }
                   17507: 
                   17508:     # last course activity filter and selection
                   17509:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   17510: 
                   17511:     # course created filter and selection
                   17512:     if (exists($filter->{'createdfilter'})) {
                   17513:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   17514:     }
                   17515: 
                   17516:     my %lt = &Apache::lonlocal::texthash(
                   17517:                 'cac' => "$crstype Activity",
                   17518:                 'ccr' => "$crstype Created",
                   17519:                 'cde' => "$crstype Title",
                   17520:                 'cdo' => "$crstype Domain",
                   17521:                 'ins' => 'Institutional Code',
                   17522:                 'inc' => 'Institutional Categorization',
                   17523:                 'cow' => "$crstype Owner/Co-owner",
                   17524:                 'cop' => "$crstype Personnel Includes",
                   17525:                 'cog' => 'Type',
                   17526:              );
                   17527: 
                   17528:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   17529:         my $typeval = 'Course';
                   17530:         if ($crstype eq 'Community') {
                   17531:             $typeval = 'Community';
                   17532:         }
                   17533:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   17534:     } else {
                   17535:         $typeselectform =  '<select name="type" size="1"';
                   17536:         if ($onchange) {
                   17537:             $typeselectform .= ' onchange="'.$onchange.'"';
                   17538:         }
                   17539:         $typeselectform .= '>'."\n";
                   17540:         foreach my $posstype ('Course','Community') {
                   17541:             $typeselectform.='<option value="'.$posstype.'"'.
                   17542:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   17543:         }
                   17544:         $typeselectform.="</select>";
                   17545:     }
                   17546: 
                   17547:     my ($cloneableonlyform,$cloneabletitle);
                   17548:     if (exists($filter->{'cloneableonly'})) {
                   17549:         my $cloneableon = '';
                   17550:         my $cloneableoff = ' checked="checked"';
                   17551:         if ($filter->{'cloneableonly'}) {
                   17552:             $cloneableon = $cloneableoff;
                   17553:             $cloneableoff = '';
                   17554:         }
                   17555:         $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>';
                   17556:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  17557:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  17558:         } else {
                   17559:             $cloneabletitle = &mt('Cloneable by you');
                   17560:         }
                   17561:     }
                   17562:     my $officialjs;
                   17563:     if ($crstype eq 'Course') {
                   17564:         if (exists($filter->{'instcodefilter'})) {
                   17565: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   17566: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   17567:             if ($codedom) {
                   17568:                 $officialjs = 1;
                   17569:                 ($instcodeform,$jscript,$$numtitlesref) =
                   17570:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   17571:                                                                   $officialjs,$codetitlesref);
                   17572:                 if ($jscript) {
                   17573:                     $jscript = '<script type="text/javascript">'."\n".
                   17574:                                '// <![CDATA['."\n".
                   17575:                                $jscript."\n".
                   17576:                                '// ]]>'."\n".
                   17577:                                '</script>'."\n";
                   17578:                 }
                   17579:             }
                   17580:             if ($instcodeform eq '') {
                   17581:                 $instcodeform =
                   17582:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   17583:                     $list->{'instcodefilter'}.'" />';
                   17584:                 $instcodetitle = $lt{'ins'};
                   17585:             } else {
                   17586:                 $instcodetitle = $lt{'inc'};
                   17587:             }
                   17588:             if ($fixeddom) {
                   17589:                 $instcodetitle .= '<br />('.$codedom.')';
                   17590:             }
                   17591:         }
                   17592:     }
                   17593:     my $output = qq|
                   17594: <form method="post" name="filterpicker" action="$action">
                   17595: <input type="hidden" name="form" value="$formname" />
                   17596: |;
                   17597:     if ($formname eq 'modifycourse') {
                   17598:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   17599:                    '<input type="hidden" name="prevphase" value="'.
                   17600:                    $prevphase.'" />'."\n";
1.1075.2.82  raeburn  17601:     } elsif ($formname eq 'quotacheck') {
                   17602:         $output .= qq|
                   17603: <input type="hidden" name="sortby" value="" />
                   17604: <input type="hidden" name="sortorder" value="" />
                   17605: |;
                   17606:     } else {
1.1075.2.69  raeburn  17607:         my $name_input;
                   17608:         if ($cnameelement ne '') {
                   17609:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   17610:                           $cnameelement.'" />';
                   17611:         }
                   17612:         $output .= qq|
                   17613: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   17614: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   17615: $name_input
                   17616: $roleelement
                   17617: $multelement
                   17618: $typeelement
                   17619: |;
                   17620:         if ($formname eq 'portform') {
                   17621:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   17622:         }
                   17623:     }
                   17624:     if ($fixeddom) {
                   17625:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   17626:     }
                   17627:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   17628:     if ($sincefilterform) {
                   17629:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   17630:                   .$sincefilterform
                   17631:                   .&Apache::lonhtmlcommon::row_closure();
                   17632:     }
                   17633:     if ($createdfilterform) {
                   17634:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   17635:                   .$createdfilterform
                   17636:                   .&Apache::lonhtmlcommon::row_closure();
                   17637:     }
                   17638:     if ($domainselectform) {
                   17639:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   17640:                   .$domainselectform
                   17641:                   .&Apache::lonhtmlcommon::row_closure();
                   17642:     }
                   17643:     if ($typeselectform) {
                   17644:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   17645:             $output .= $typeselectform;
                   17646:         } else {
                   17647:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   17648:                       .$typeselectform
                   17649:                       .&Apache::lonhtmlcommon::row_closure();
                   17650:         }
                   17651:     }
                   17652:     if ($instcodeform) {
                   17653:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   17654:                   .$instcodeform
                   17655:                   .&Apache::lonhtmlcommon::row_closure();
                   17656:     }
                   17657:     if (exists($filter->{'ownerfilter'})) {
                   17658:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   17659:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   17660:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   17661:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   17662:                    $ownerdomselectform.'</td></tr></table>'.
                   17663:                    &Apache::lonhtmlcommon::row_closure();
                   17664:     }
                   17665:     if (exists($filter->{'personfilter'})) {
                   17666:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   17667:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   17668:                    '<input type="text" name="personfilter" size="20" value="'.
                   17669:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   17670:                    $persondomselectform.'</td></tr></table>'.
                   17671:                    &Apache::lonhtmlcommon::row_closure();
                   17672:     }
                   17673:     if (exists($filter->{'coursefilter'})) {
                   17674:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   17675:                   .'<input type="text" name="coursefilter" size="25" value="'
                   17676:                   .$list->{'coursefilter'}.'" />'
                   17677:                   .&Apache::lonhtmlcommon::row_closure();
                   17678:     }
                   17679:     if ($cloneableonlyform) {
                   17680:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   17681:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   17682:     }
                   17683:     if (exists($filter->{'descriptfilter'})) {
                   17684:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   17685:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   17686:                   .$list->{'descriptfilter'}.'" />'
                   17687:                   .&Apache::lonhtmlcommon::row_closure(1);
                   17688:     }
                   17689:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   17690:                '<input type="hidden" name="updater" value="" />'."\n".
                   17691:                '<input type="submit" name="gosearch" value="'.
                   17692:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   17693:     return $jscript.$clonewarning.$output;
                   17694: }
                   17695: 
                   17696: =pod
                   17697: 
                   17698: =item * &timebased_select_form()
                   17699: 
                   17700: Create markup for a dropdown list used to select a time-based
                   17701: filter e.g., Course Activity, Course Created, when searching for courses
                   17702: or communities
                   17703: 
                   17704: Inputs:
                   17705: 
                   17706: item - name of form element (sincefilter or createdfilter)
                   17707: 
                   17708: filter - anonymous hash of criteria and their values
                   17709: 
                   17710: Returns: HTML for a select box contained a blank, then six time selections,
                   17711:          with value set in incoming form variables currently selected.
                   17712: 
                   17713: Side Effects: None
                   17714: 
                   17715: =cut
                   17716: 
                   17717: sub timebased_select_form {
                   17718:     my ($item,$filter) = @_;
                   17719:     if (ref($filter) eq 'HASH') {
                   17720:         $filter->{$item} =~ s/[^\d-]//g;
                   17721:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   17722:         return &select_form(
                   17723:                             $filter->{$item},
                   17724:                             $item,
                   17725:                             {      '-1' => '',
                   17726:                                 '86400' => &mt('today'),
                   17727:                                '604800' => &mt('last week'),
                   17728:                               '2592000' => &mt('last month'),
                   17729:                               '7776000' => &mt('last three months'),
                   17730:                              '15552000' => &mt('last six months'),
                   17731:                              '31104000' => &mt('last year'),
                   17732:                     'select_form_order' =>
                   17733:                            ['-1','86400','604800','2592000','7776000',
                   17734:                             '15552000','31104000']});
                   17735:     }
                   17736: }
                   17737: 
                   17738: =pod
                   17739: 
                   17740: =item * &js_changer()
                   17741: 
                   17742: Create script tag containing Javascript used to submit course search form
                   17743: when course type or domain is changed, and also to hide 'Searching ...' on
                   17744: page load completion for page showing search result.
                   17745: 
                   17746: Inputs: None
                   17747: 
                   17748: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   17749: 
                   17750: Side Effects: None
                   17751: 
                   17752: =cut
                   17753: 
                   17754: sub js_changer {
                   17755:     return <<ENDJS;
                   17756: <script type="text/javascript">
                   17757: // <![CDATA[
                   17758: function updateFilters(caller) {
                   17759:     if (typeof(caller) != "undefined") {
                   17760:         document.filterpicker.updater.value = caller.name;
                   17761:     }
                   17762:     document.filterpicker.submit();
                   17763: }
                   17764: 
                   17765: function hideSearching() {
                   17766:     if (document.getElementById('searching')) {
                   17767:         document.getElementById('searching').style.display = 'none';
                   17768:     }
                   17769:     return;
                   17770: }
                   17771: 
                   17772: // ]]>
                   17773: </script>
                   17774: 
                   17775: ENDJS
                   17776: }
                   17777: 
                   17778: =pod
                   17779: 
                   17780: =item * &search_courses()
                   17781: 
                   17782: Process selected filters form course search form and pass to lonnet::courseiddump
                   17783: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   17784: 
                   17785: Inputs:
                   17786: 
                   17787: dom - domain being searched
                   17788: 
                   17789: type - course type ('Course' or 'Community' or '.' if any).
                   17790: 
                   17791: filter - anonymous hash of criteria and their values
                   17792: 
                   17793: numtitles - for institutional codes - number of categories
                   17794: 
                   17795: cloneruname - optional username of new course owner
                   17796: 
                   17797: clonerudom - optional domain of new course owner
                   17798: 
1.1075.2.95  raeburn  17799: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69  raeburn  17800:             (used when DC is using course creation form)
                   17801: 
                   17802: codetitles - reference to array of titles of components in institutional codes (official courses).
                   17803: 
1.1075.2.95  raeburn  17804: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   17805:            (and so can clone automatically)
                   17806: 
                   17807: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   17808: 
                   17809: reqinstcode - institutional code of new course, where search_courses is used to identify potential
                   17810:               courses to clone
1.1075.2.69  raeburn  17811: 
                   17812: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   17813: 
                   17814: 
                   17815: Side Effects: None
                   17816: 
                   17817: =cut
                   17818: 
                   17819: 
                   17820: sub search_courses {
1.1075.2.95  raeburn  17821:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   17822:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69  raeburn  17823:     my (%courses,%showcourses,$cloner);
                   17824:     if (($filter->{'ownerfilter'} ne '') ||
                   17825:         ($filter->{'ownerdomfilter'} ne '')) {
                   17826:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   17827:                                        $filter->{'ownerdomfilter'};
                   17828:     }
                   17829:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   17830:         if (!$filter->{$item}) {
                   17831:             $filter->{$item}='.';
                   17832:         }
                   17833:     }
                   17834:     my $now = time;
                   17835:     my $timefilter =
                   17836:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   17837:     my ($createdbefore,$createdafter);
                   17838:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   17839:         $createdbefore = $now;
                   17840:         $createdafter = $now-$filter->{'createdfilter'};
                   17841:     }
                   17842:     my ($instcodefilter,$regexpok);
                   17843:     if ($numtitles) {
                   17844:         if ($env{'form.official'} eq 'on') {
                   17845:             $instcodefilter =
                   17846:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   17847:             $regexpok = 1;
                   17848:         } elsif ($env{'form.official'} eq 'off') {
                   17849:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   17850:             unless ($instcodefilter eq '') {
                   17851:                 $regexpok = -1;
                   17852:             }
                   17853:         }
                   17854:     } else {
                   17855:         $instcodefilter = $filter->{'instcodefilter'};
                   17856:     }
                   17857:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   17858:     if ($type eq '') { $type = '.'; }
                   17859: 
                   17860:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   17861:         $cloner = $cloneruname.':'.$clonerudom;
                   17862:     }
                   17863:     %courses = &Apache::lonnet::courseiddump($dom,
                   17864:                                              $filter->{'descriptfilter'},
                   17865:                                              $timefilter,
                   17866:                                              $instcodefilter,
                   17867:                                              $filter->{'combownerfilter'},
                   17868:                                              $filter->{'coursefilter'},
                   17869:                                              undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95  raeburn  17870:                                              undef,undef,$cloner,$cc_clone,
1.1075.2.69  raeburn  17871:                                              $filter->{'cloneableonly'},
                   17872:                                              $createdbefore,$createdafter,undef,
1.1075.2.95  raeburn  17873:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69  raeburn  17874:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   17875:         my $ccrole;
                   17876:         if ($type eq 'Community') {
                   17877:             $ccrole = 'co';
                   17878:         } else {
                   17879:             $ccrole = 'cc';
                   17880:         }
                   17881:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   17882:                                                      $filter->{'persondomfilter'},
                   17883:                                                      'userroles',undef,
                   17884:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   17885:                                                      $dom);
                   17886:         foreach my $role (keys(%rolehash)) {
                   17887:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   17888:             my $cid = $cdom.'_'.$cnum;
                   17889:             if (exists($courses{$cid})) {
                   17890:                 if (ref($courses{$cid}) eq 'HASH') {
                   17891:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   17892:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1075.2.119  raeburn  17893:                             push(@{$courses{$cid}{roles}},$courserole);
1.1075.2.69  raeburn  17894:                         }
                   17895:                     } else {
                   17896:                         $courses{$cid}{roles} = [$courserole];
                   17897:                     }
                   17898:                     $showcourses{$cid} = $courses{$cid};
                   17899:                 }
                   17900:             }
                   17901:         }
                   17902:         %courses = %showcourses;
                   17903:     }
                   17904:     return %courses;
                   17905: }
                   17906: 
                   17907: =pod
                   17908: 
                   17909: =back
                   17910: 
1.1075.2.88  raeburn  17911: =head1 Routines for version requirements for current course.
                   17912: 
                   17913: =over 4
                   17914: 
                   17915: =item * &check_release_required()
                   17916: 
                   17917: Compares required LON-CAPA version with version on server, and
                   17918: if required version is newer looks for a server with the required version.
                   17919: 
                   17920: Looks first at servers in user's owen domain; if none suitable, looks at
                   17921: servers in course's domain are permitted to host sessions for user's domain.
                   17922: 
                   17923: Inputs:
                   17924: 
                   17925: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   17926: 
                   17927: $courseid - Course ID of current course
                   17928: 
                   17929: $rolecode - User's current role in course (for switchserver query string).
                   17930: 
                   17931: $required - LON-CAPA version needed by course (format: Major.Minor).
                   17932: 
                   17933: 
                   17934: Returns:
                   17935: 
                   17936: $switchserver - query string tp append to /adm/switchserver call (if
                   17937:                 current server's LON-CAPA version is too old.
                   17938: 
                   17939: $warning - Message is displayed if no suitable server could be found.
                   17940: 
                   17941: =cut
                   17942: 
                   17943: sub check_release_required {
                   17944:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   17945:     my ($switchserver,$warning);
                   17946:     if ($required ne '') {
                   17947:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   17948:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   17949:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   17950:             my $otherserver;
                   17951:             if (($major eq '' && $minor eq '') ||
                   17952:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   17953:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   17954:                 my $switchlcrev =
                   17955:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   17956:                                                            $userdomserver);
                   17957:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   17958:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   17959:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   17960:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   17961:                     if ($cdom ne $env{'user.domain'}) {
                   17962:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   17963:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   17964:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   17965:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   17966:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   17967:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   17968:                         my $canhost =
                   17969:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   17970:                                                               $coursedomserver,
                   17971:                                                               $remoterev,
                   17972:                                                               $udomdefaults{'remotesessions'},
                   17973:                                                               $defdomdefaults{'hostedsessions'});
                   17974: 
                   17975:                         if ($canhost) {
                   17976:                             $otherserver = $coursedomserver;
                   17977:                         } else {
                   17978:                             $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.");
                   17979:                         }
                   17980:                     } else {
                   17981:                         $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).");
                   17982:                     }
                   17983:                 } else {
                   17984:                     $otherserver = $userdomserver;
                   17985:                 }
                   17986:             }
                   17987:             if ($otherserver ne '') {
                   17988:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   17989:             }
                   17990:         }
                   17991:     }
                   17992:     return ($switchserver,$warning);
                   17993: }
                   17994: 
                   17995: =pod
                   17996: 
                   17997: =item * &check_release_result()
                   17998: 
                   17999: Inputs:
                   18000: 
                   18001: $switchwarning - Warning message if no suitable server found to host session.
                   18002: 
                   18003: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   18004:                 and current role.
                   18005: 
                   18006: Returns: HTML to display with information about requirement to switch server.
                   18007:          Either displaying warning with link to Roles/Courses screen or
                   18008:          display link to switchserver.
                   18009: 
1.1075.2.69  raeburn  18010: =cut
                   18011: 
1.1075.2.88  raeburn  18012: sub check_release_result {
                   18013:     my ($switchwarning,$switchserver) = @_;
                   18014:     my $output = &start_page('Selected course unavailable on this server').
                   18015:                  '<p class="LC_warning">';
                   18016:     if ($switchwarning) {
                   18017:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   18018:         if (&show_course()) {
                   18019:             $output .= &mt('Display courses');
                   18020:         } else {
                   18021:             $output .= &mt('Display roles');
                   18022:         }
                   18023:         $output .= '</a>';
                   18024:     } elsif ($switchserver) {
                   18025:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   18026:                    '<br />'.
                   18027:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   18028:                    &mt('Switch Server').
                   18029:                    '</a>';
                   18030:     }
                   18031:     $output .= '</p>'.&end_page();
                   18032:     return $output;
                   18033: }
                   18034: 
                   18035: =pod
                   18036: 
                   18037: =item * &needs_coursereinit()
                   18038: 
                   18039: Determine if course contents stored for user's session needs to be
                   18040: refreshed, because content has changed since "Big Hash" last tied.
                   18041: 
                   18042: Check for change is made if time last checked is more than 10 minutes ago
                   18043: (by default).
                   18044: 
                   18045: Inputs:
                   18046: 
                   18047: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   18048: 
                   18049: $interval (optional) - Time which may elapse (in s) between last check for content
                   18050:                        change in current course. (default: 600 s).
                   18051: 
                   18052: Returns: an array; first element is:
                   18053: 
                   18054: =over 4
                   18055: 
                   18056: 'switch' - if content updates mean user's session
                   18057:            needs to be switched to a server running a newer LON-CAPA version
                   18058: 
                   18059: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   18060:            on current server hosting user's session
                   18061: 
                   18062: ''       - if no action required.
                   18063: 
                   18064: =back
                   18065: 
                   18066: If first item element is 'switch':
                   18067: 
                   18068: second item is $switchwarning - Warning message if no suitable server found to host session.
                   18069: 
                   18070: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   18071:                               and current role.
                   18072: 
                   18073: otherwise: no other elements returned.
                   18074: 
                   18075: =back
                   18076: 
                   18077: =cut
                   18078: 
                   18079: sub needs_coursereinit {
                   18080:     my ($loncaparev,$interval) = @_;
                   18081:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   18082:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   18083:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   18084:     my $now = time;
                   18085:     if ($interval eq '') {
                   18086:         $interval = 600;
                   18087:     }
                   18088:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   18089:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1075.2.161.  .4(raebu 18090:22):         my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
          .1(raebu 18091:21):         if ($blocked) {
                   18092:21):             return ();
                   18093:21):         }
          .13(raeb 18094:-23):         my $update;
                   18095:-23):         my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   18096:-23):         my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
                   18097:-23):         if ($lastmainchange > $env{'request.course.tied'}) {
                   18098:-23):             my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                   18099:-23):             if ($needswitch) {
                   18100:-23):                 return ('switch',$switchwarning,$switchserver);
                   18101:-23):             }
                   18102:-23):             $update = 'main';
                   18103:-23):         }
                   18104:-23):         if ($lastsuppchange > $env{'request.course.suppupdated'}) {
                   18105:-23):             if ($update) {
                   18106:-23):                 $update = 'both';
                   18107:-23):             } else {
                   18108:-23):                 my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                   18109:-23):                 if ($needswitch) {
                   18110:-23):                     return ('switch',$switchwarning,$switchserver);
                   18111:-23):                 } else {
                   18112:-23):                     $update = 'supp';
1.1075.2.88  raeburn  18113:                 }
                   18114:             }
1.1075.2.161.  .13(raeb 18115:-23):             return ($update);
                   18116:-23):         }
                   18117:-23):     }
                   18118:-23):     return ();
                   18119:-23): }
                   18120:-23): 
                   18121:-23): sub switch_for_update {
                   18122:-23):     my ($loncaparev,$cdom,$cnum) = @_;
                   18123:-23):     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   18124:-23):     if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   18125:-23):         my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   18126:-23):         if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   18127:-23):             &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   18128:-23):                                     $curr_reqd_hash{'internal.releaserequired'}});
                   18129:-23):             my ($switchserver,$switchwarning) =
                   18130:-23):                 &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   18131:-23):                                         $curr_reqd_hash{'internal.releaserequired'});
                   18132:-23):             if ($switchwarning ne '' || $switchserver ne '') {
                   18133:-23):                 return ('switch',$switchwarning,$switchserver);
                   18134:-23):             }
1.1075.2.88  raeburn  18135:         }
                   18136:     }
                   18137:     return ();
                   18138: }
1.1075.2.69  raeburn  18139: 
1.1075.2.11  raeburn  18140: sub update_content_constraints {
                   18141:     my ($cdom,$cnum,$chome,$cid) = @_;
                   18142:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   18143:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   18144:     my %checkresponsetypes;
                   18145:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   18146:         my ($item,$name,$value) = split(/:/,$key);
                   18147:         if ($item eq 'resourcetag') {
                   18148:             if ($name eq 'responsetype') {
                   18149:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   18150:             }
                   18151:         }
                   18152:     }
                   18153:     my $navmap = Apache::lonnavmaps::navmap->new();
                   18154:     if (defined($navmap)) {
                   18155:         my %allresponses;
                   18156:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   18157:             my %responses = $res->responseTypes();
                   18158:             foreach my $key (keys(%responses)) {
                   18159:                 next unless(exists($checkresponsetypes{$key}));
                   18160:                 $allresponses{$key} += $responses{$key};
                   18161:             }
                   18162:         }
                   18163:         foreach my $key (keys(%allresponses)) {
                   18164:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   18165:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   18166:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   18167:             }
                   18168:         }
                   18169:         undef($navmap);
                   18170:     }
                   18171:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   18172:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   18173:     }
                   18174:     return;
                   18175: }
                   18176: 
1.1075.2.27  raeburn  18177: sub allmaps_incourse {
                   18178:     my ($cdom,$cnum,$chome,$cid) = @_;
                   18179:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   18180:         $cid = $env{'request.course.id'};
                   18181:         $cdom = $env{'course.'.$cid.'.domain'};
                   18182:         $cnum = $env{'course.'.$cid.'.num'};
                   18183:         $chome = $env{'course.'.$cid.'.home'};
                   18184:     }
                   18185:     my %allmaps = ();
                   18186:     my $lastchange =
                   18187:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   18188:     if ($lastchange > $env{'request.course.tied'}) {
                   18189:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   18190:         unless ($ferr) {
                   18191:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   18192:         }
                   18193:     }
                   18194:     my $navmap = Apache::lonnavmaps::navmap->new();
                   18195:     if (defined($navmap)) {
                   18196:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   18197:             $allmaps{$res->src()} = 1;
                   18198:         }
                   18199:     }
                   18200:     return \%allmaps;
                   18201: }
                   18202: 
1.1075.2.11  raeburn  18203: sub parse_supplemental_title {
                   18204:     my ($title) = @_;
                   18205: 
                   18206:     my ($foldertitle,$renametitle);
                   18207:     if ($title =~ /&amp;&amp;&amp;/) {
                   18208:         $title = &HTML::Entites::decode($title);
                   18209:     }
                   18210:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   18211:         $renametitle=$4;
                   18212:         my ($time,$uname,$udom) = ($1,$2,$3);
                   18213:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   18214:         my $name =  &plainname($uname,$udom);
                   18215:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   18216:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
1.1075.2.161.  .16(raeb 18217:-23):         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
                   18218:-23):         if ($foldertitle ne '') {
                   18219:-23):             $title .= ': <br />'.$foldertitle;
                   18220:-23):         }
1.1075.2.11  raeburn  18221:     }
                   18222:     if (wantarray) {
                   18223:         return ($title,$foldertitle,$renametitle);
                   18224:     }
                   18225:     return $title;
                   18226: }
                   18227: 
1.1075.2.161.  .13(raeb 18228:-23): sub get_supplemental {
                   18229:-23):     my ($cnum,$cdom,$ignorecache,$possdel)=@_;
                   18230:-23):     my $hashid=$cnum.':'.$cdom;
                   18231:-23):     my ($supplemental,$cached,$set_httprefs);
                   18232:-23):     unless ($ignorecache) {
                   18233:-23):         ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
                   18234:-23):     }
                   18235:-23):     unless (defined($cached)) {
                   18236:-23):         my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
                   18237:-23):         unless ($chome eq 'no_host') {
                   18238:-23):             my @order = @LONCAPA::map::order;
                   18239:-23):             my @resources = @LONCAPA::map::resources;
                   18240:-23):             my @resparms = @LONCAPA::map::resparms;
                   18241:-23):             my @zombies = @LONCAPA::map::zombies;
                   18242:-23):             my ($errors,%ids,%hidden);
                   18243:-23):             $errors =
                   18244:-23):                 &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
                   18245:-23):                                       $errors,$possdel,\%ids,\%hidden);
                   18246:-23):             @LONCAPA::map::order = @order;
                   18247:-23):             @LONCAPA::map::resources = @resources;
                   18248:-23):             @LONCAPA::map::resparms = @resparms;
                   18249:-23):             @LONCAPA::map::zombies = @zombies;
                   18250:-23):             $set_httprefs = 1;
                   18251:-23):             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   18252:-23):                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});
                   18253:-23):             }
                   18254:-23):             $supplemental = {
                   18255:-23):                                ids => \%ids,
                   18256:-23):                                hidden => \%hidden,
                   18257:-23):                             };
                   18258:-23):             &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
                   18259:-23):         }
                   18260:-23):     }
                   18261:-23):     return ($supplemental,$set_httprefs);
                   18262:-23): }
                   18263:-23): 
1.1075.2.43  raeburn  18264: sub recurse_supplemental {
1.1075.2.161.  .13(raeb 18265:-23):     my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
                   18266:-23):     if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
                   18267:-23):         my $mapnum;
                   18268:-23):         if ($suppmap eq 'supplemental.sequence') {
                   18269:-23):             $mapnum = 0;
                   18270:-23):         } else {
                   18271:-23):             ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
                   18272:-23):         }
1.1075.2.43  raeburn  18273:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   18274:         if ($fatal) {
                   18275:             $errors ++;
                   18276:         } else {
1.1075.2.161.  .13(raeb 18277:-23):             my @order = @LONCAPA::map::order;
                   18278:-23):             if (@order > 0) {
                   18279:-23):                 my @resources = @LONCAPA::map::resources;
                   18280:-23):                 my @resparms = @LONCAPA::map::resparms;
                   18281:-23):                 foreach my $idx (@order) {
                   18282:-23):                     my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1075.2.43  raeburn  18283:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.161.  .13(raeb 18284:-23):                         my $id = $mapnum.':'.$idx;
                   18285:-23):                         push(@{$suppids->{$src}},$id);
                   18286:-23):                         if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
                   18287:-23):                             $hiddensupp->{$id} = 1;
                   18288:-23):                         }
1.1075.2.46  raeburn  18289:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1075.2.161.  .13(raeb 18290:-23):                             $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
                   18291:-23):                                                             $hiddensupp,$hiddensupp->{$id});
1.1075.2.43  raeburn  18292:                         } else {
1.1075.2.161.  .13(raeb 18293:-23):                             my $allowed;
                   18294:-23):                             if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
                   18295:-23):                                 $allowed = 1;
                   18296:-23):                             } elsif ($possdel) {
                   18297:-23):                                 foreach my $item (@{$suppids->{$src}}) {
                   18298:-23):                                     next if ($item eq $id);
                   18299:-23):                                     unless ($hiddensupp->{$item}) {
                   18300:-23):                                        $allowed = 1;
                   18301:-23):                                        last;
                   18302:-23):                                     }
                   18303:-23):                                 }
                   18304:-23):                                 if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
                   18305:-23):                                     &Apache::lonnet::delenv('httpref.'.$src);
                   18306:-23):                                 }
                   18307:-23):                             }
                   18308:-23):                             if ($allowed && (!exists($env{'httpref.'.$src}))) {
                   18309:-23):                                 &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
                   18310:-23):                             }
                   18311:-23):                         }
                   18312:-23):                     }
                   18313:-23):                 }
                   18314:-23):             }
                   18315:-23):         }
                   18316:-23):     }
                   18317:-23):     return $errors;
                   18318:-23): }
                   18319:-23): 
                   18320:-23): sub set_supp_httprefs {
                   18321:-23):     my ($cnum,$cdom,$supplemental,$possdel) = @_;
                   18322:-23):     if (ref($supplemental) eq 'HASH') {
                   18323:-23):         if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
                   18324:-23):             foreach my $src (keys(%{$supplemental->{'ids'}})) {
                   18325:-23):                 next if ($src =~ /\.sequence$/);
                   18326:-23):                 if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
                   18327:-23):                     my $allowed;
                   18328:-23):                     if ($env{'request.role.adv'}) {
                   18329:-23):                         $allowed = 1;
                   18330:-23):                     } else {
                   18331:-23):                         foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
                   18332:-23):                             unless ($supplemental->{'hidden'}->{$id}) {
                   18333:-23):                                 $allowed = 1;
                   18334:-23):                                 last;
                   18335:-23):                             }
                   18336:-23):                         }
                   18337:-23):                     }
                   18338:-23):                     if (exists($env{'httpref.'.$src})) {
                   18339:-23):                         if ($possdel) {
                   18340:-23):                             unless ($allowed) {
                   18341:-23):                                 &Apache::lonnet::delenv('httpref.'.$src);
                   18342:-23):                             }
1.1075.2.43  raeburn  18343:                         }
1.1075.2.161.  .13(raeb 18344:-23):                     } elsif ($allowed) {
                   18345:-23):                         &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1075.2.43  raeburn  18346:                     }
                   18347:                 }
                   18348:             }
1.1075.2.161.  .13(raeb 18349:-23):             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   18350:-23):                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});
                   18351:-23):             }
1.1075.2.43  raeburn  18352:         }
                   18353:     }
1.1075.2.161.  .13(raeb 18354:-23): }
                   18355:-23): 
                   18356:-23): sub get_supp_parameter {
                   18357:-23):     my ($resparm,$name)=@_;
                   18358:-23):     return if ($resparm eq '');
                   18359:-23):     my $value=undef;
                   18360:-23):     my $ptype=undef;
                   18361:-23):     foreach (split('&&&',$resparm)) {
                   18362:-23):         my ($thistype,$thisname,$thisvalue)=split('___',$_);
                   18363:-23):         if ($thisname eq $name) {
                   18364:-23):             $value=$thisvalue;
                   18365:-23):             $ptype=$thistype;
                   18366:-23):         }
                   18367:-23):     }
                   18368:-23):     return $value;
1.1075.2.43  raeburn  18369: }
                   18370: 
1.1075.2.18  raeburn  18371: sub symb_to_docspath {
1.1075.2.119  raeburn  18372:     my ($symb,$navmapref) = @_;
                   18373:     return unless ($symb && ref($navmapref));
1.1075.2.18  raeburn  18374:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   18375:     if ($resurl=~/\.(sequence|page)$/) {
                   18376:         $mapurl=$resurl;
                   18377:     } elsif ($resurl eq 'adm/navmaps') {
                   18378:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   18379:     }
                   18380:     my $mapresobj;
1.1075.2.119  raeburn  18381:     unless (ref($$navmapref)) {
                   18382:         $$navmapref = Apache::lonnavmaps::navmap->new();
                   18383:     }
                   18384:     if (ref($$navmapref)) {
                   18385:         $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1075.2.18  raeburn  18386:     }
                   18387:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   18388:     my $type=$2;
                   18389:     my $path;
                   18390:     if (ref($mapresobj)) {
                   18391:         my $pcslist = $mapresobj->map_hierarchy();
                   18392:         if ($pcslist ne '') {
                   18393:             foreach my $pc (split(/,/,$pcslist)) {
                   18394:                 next if ($pc <= 1);
1.1075.2.119  raeburn  18395:                 my $res = $$navmapref->getByMapPc($pc);
1.1075.2.18  raeburn  18396:                 if (ref($res)) {
                   18397:                     my $thisurl = $res->src();
                   18398:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   18399:                     my $thistitle = $res->title();
                   18400:                     $path .= '&'.
                   18401:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  18402:                              &escape($thistitle).
1.1075.2.18  raeburn  18403:                              ':'.$res->randompick().
                   18404:                              ':'.$res->randomout().
                   18405:                              ':'.$res->encrypted().
                   18406:                              ':'.$res->randomorder().
                   18407:                              ':'.$res->is_page();
                   18408:                 }
                   18409:             }
                   18410:         }
                   18411:         $path =~ s/^\&//;
                   18412:         my $maptitle = $mapresobj->title();
                   18413:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  18414:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  18415:         }
                   18416:         $path .= (($path ne '')? '&' : '').
                   18417:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  18418:                  &escape($maptitle).
1.1075.2.18  raeburn  18419:                  ':'.$mapresobj->randompick().
                   18420:                  ':'.$mapresobj->randomout().
                   18421:                  ':'.$mapresobj->encrypted().
                   18422:                  ':'.$mapresobj->randomorder().
                   18423:                  ':'.$mapresobj->is_page();
                   18424:     } else {
                   18425:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   18426:         my $ispage = (($type eq 'page')? 1 : '');
                   18427:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  18428:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  18429:         }
                   18430:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  18431:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  18432:     }
                   18433:     unless ($mapurl eq 'default') {
                   18434:         $path = 'default&'.
1.1075.2.46  raeburn  18435:                 &escape('Main Content').
1.1075.2.18  raeburn  18436:                 ':::::&'.$path;
                   18437:     }
                   18438:     return $path;
                   18439: }
                   18440: 
1.1075.2.161.  .13(raeb 18441:-23): sub validate_folderpath {
                   18442:-23):     my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
                   18443:-23):     if ($env{'form.folderpath'} ne '') {
                   18444:-23):         my @items = split(/\&/,$env{'form.folderpath'});
                   18445:-23):         my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
                   18446:-23):         for (my $i=0; $i<@items; $i++) {
                   18447:-23):             my $odd = $i%2;
                   18448:-23):             if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
                   18449:-23):                 $badpath = 1;
                   18450:-23):             } elsif ($odd && $supplementalflag) {
                   18451:-23):                 my $idx = $i-1;
                   18452:-23):                 if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
                   18453:-23):                     my $esc_name = $1;
                   18454:-23):                     if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
                   18455:-23):                         $supppath .= '&'.$esc_name;
                   18456:-23):                         $changed = 1;
                   18457:-23):                     } else {
                   18458:-23):                         $supppath .= '&'.$items[$i];
                   18459:-23):                     }
                   18460:-23):                 } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
                   18461:-23):                     $changed = 1;
                   18462:-23):                     my $is_hidden;
                   18463:-23):                     unless ($got_supp) {
                   18464:-23):                         my ($supplemental) = &get_supplemental($coursenum,$coursedom);
                   18465:-23):                         if (ref($supplemental) eq 'HASH') {
                   18466:-23):                             if (ref($supplemental->{'hidden'}) eq 'HASH') {
                   18467:-23):                                 %supphidden = %{$supplemental->{'hidden'}};
                   18468:-23):                             }
                   18469:-23):                             if (ref($supplemental->{'ids'}) eq 'HASH') {
                   18470:-23):                                 %suppids = %{$supplemental->{'ids'}};
                   18471:-23):                             }
                   18472:-23):                         }
                   18473:-23):                         $got_supp = 1;
                   18474:-23):                     }
                   18475:-23):                     if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
                   18476:-23):                         my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
                   18477:-23):                         if ($supphidden{$mapid}) {
                   18478:-23):                             $is_hidden = 1;
                   18479:-23):                         }
                   18480:-23):                     }
                   18481:-23):                     $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
                   18482:-23):                 } else {
                   18483:-23):                     $supppath .= '&'.$items[$i];
                   18484:-23):                 }
                   18485:-23):             } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
                   18486:-23):                 $badpath = 1;
                   18487:-23):             } elsif ($supplementalflag) {
                   18488:-23):                 $supppath .= '&'.$items[$i];
                   18489:-23):             }
                   18490:-23):             last if ($badpath);
                   18491:-23):         }
                   18492:-23):         if ($badpath) {
                   18493:-23):             delete($env{'form.folderpath'});
                   18494:-23):         } elsif ($changed && $supplementalflag) {
                   18495:-23):             $supppath =~ s/^\&//;
                   18496:-23):             $env{'form.folderpath'} = $supppath;
                   18497:-23):         }
                   18498:-23):     }
                   18499:-23):     return;
                   18500:-23): }
                   18501:-23): 
1.1075.2.14  raeburn  18502: sub captcha_display {
1.1075.2.137  raeburn  18503:     my ($context,$lonhost,$defdom) = @_;
1.1075.2.14  raeburn  18504:     my ($output,$error);
1.1075.2.107  raeburn  18505:     my ($captcha,$pubkey,$privkey,$version) =
1.1075.2.137  raeburn  18506:         &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14  raeburn  18507:     if ($captcha eq 'original') {
                   18508:         $output = &create_captcha();
                   18509:         unless ($output) {
                   18510:             $error = 'captcha';
                   18511:         }
                   18512:     } elsif ($captcha eq 'recaptcha') {
1.1075.2.107  raeburn  18513:         $output = &create_recaptcha($pubkey,$version);
1.1075.2.14  raeburn  18514:         unless ($output) {
                   18515:             $error = 'recaptcha';
                   18516:         }
                   18517:     }
1.1075.2.107  raeburn  18518:     return ($output,$error,$captcha,$version);
1.1075.2.14  raeburn  18519: }
                   18520: 
                   18521: sub captcha_response {
1.1075.2.137  raeburn  18522:     my ($context,$lonhost,$defdom) = @_;
1.1075.2.14  raeburn  18523:     my ($captcha_chk,$captcha_error);
1.1075.2.137  raeburn  18524:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14  raeburn  18525:     if ($captcha eq 'original') {
                   18526:         ($captcha_chk,$captcha_error) = &check_captcha();
                   18527:     } elsif ($captcha eq 'recaptcha') {
1.1075.2.107  raeburn  18528:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1075.2.14  raeburn  18529:     } else {
                   18530:         $captcha_chk = 1;
                   18531:     }
                   18532:     return ($captcha_chk,$captcha_error);
                   18533: }
                   18534: 
                   18535: sub get_captcha_config {
1.1075.2.137  raeburn  18536:     my ($context,$lonhost,$dom_in_effect) = @_;
1.1075.2.107  raeburn  18537:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1075.2.14  raeburn  18538:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   18539:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   18540:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   18541:     if ($context eq 'usercreation') {
                   18542:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   18543:         if (ref($domconfig{$context}) eq 'HASH') {
                   18544:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   18545:             if (ref($hashtocheck) eq 'HASH') {
                   18546:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   18547:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   18548:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   18549:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   18550:                     }
                   18551:                     if ($privkey && $pubkey) {
                   18552:                         $captcha = 'recaptcha';
1.1075.2.107  raeburn  18553:                         $version = $hashtocheck->{'recaptchaversion'};
                   18554:                         if ($version ne '2') {
                   18555:                             $version = 1;
                   18556:                         }
1.1075.2.14  raeburn  18557:                     } else {
                   18558:                         $captcha = 'original';
                   18559:                     }
                   18560:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   18561:                     $captcha = 'original';
                   18562:                 }
                   18563:             }
                   18564:         } else {
                   18565:             $captcha = 'captcha';
                   18566:         }
                   18567:     } elsif ($context eq 'login') {
                   18568:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   18569:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   18570:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   18571:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   18572:             if ($privkey && $pubkey) {
                   18573:                 $captcha = 'recaptcha';
1.1075.2.107  raeburn  18574:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   18575:                 if ($version ne '2') {
                   18576:                     $version = 1;
                   18577:                 }
1.1075.2.14  raeburn  18578:             } else {
                   18579:                 $captcha = 'original';
                   18580:             }
                   18581:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   18582:             $captcha = 'original';
                   18583:         }
1.1075.2.137  raeburn  18584:     } elsif ($context eq 'passwords') {
                   18585:         if ($dom_in_effect) {
                   18586:             my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
                   18587:             if ($passwdconf{'captcha'} eq 'recaptcha') {
                   18588:                 if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
                   18589:                     $pubkey = $passwdconf{'recaptchakeys'}{'public'};
                   18590:                     $privkey = $passwdconf{'recaptchakeys'}{'private'};
                   18591:                 }
                   18592:                 if ($privkey && $pubkey) {
                   18593:                     $captcha = 'recaptcha';
                   18594:                     $version = $passwdconf{'recaptchaversion'};
                   18595:                     if ($version ne '2') {
                   18596:                         $version = 1;
                   18597:                     }
                   18598:                 } else {
                   18599:                     $captcha = 'original';
                   18600:                 }
                   18601:             } elsif ($passwdconf{'captcha'} ne 'notused') {
                   18602:                 $captcha = 'original';
                   18603:             }
                   18604:         }
1.1075.2.14  raeburn  18605:     }
1.1075.2.107  raeburn  18606:     return ($captcha,$pubkey,$privkey,$version);
1.1075.2.14  raeburn  18607: }
                   18608: 
                   18609: sub create_captcha {
                   18610:     my %captcha_params = &captcha_settings();
                   18611:     my ($output,$maxtries,$tries) = ('',10,0);
                   18612:     while ($tries < $maxtries) {
                   18613:         $tries ++;
                   18614:         my $captcha = Authen::Captcha->new (
                   18615:                                            output_folder => $captcha_params{'output_dir'},
                   18616:                                            data_folder   => $captcha_params{'db_dir'},
                   18617:                                           );
                   18618:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   18619: 
                   18620:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   18621:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1075.2.158  raeburn  18622:                       '<span class="LC_nobreak">'.
1.1075.2.14  raeburn  18623:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.161.  .15(raeb 18624:-23):                       '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1075.2.158  raeburn  18625:                       '</span><br />'.
1.1075.2.66  raeburn  18626:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  18627:             last;
                   18628:         }
                   18629:     }
1.1075.2.158  raeburn  18630:     if ($output eq '') {
                   18631:         &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
                   18632:     }
1.1075.2.14  raeburn  18633:     return $output;
                   18634: }
                   18635: 
                   18636: sub captcha_settings {
                   18637:     my %captcha_params = (
                   18638:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   18639:                            www_output_dir => "/captchaspool",
                   18640:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   18641:                            numchars       => '5',
                   18642:                          );
                   18643:     return %captcha_params;
                   18644: }
                   18645: 
                   18646: sub check_captcha {
                   18647:     my ($captcha_chk,$captcha_error);
                   18648:     my $code = $env{'form.code'};
                   18649:     my $md5sum = $env{'form.crypt'};
                   18650:     my %captcha_params = &captcha_settings();
                   18651:     my $captcha = Authen::Captcha->new(
                   18652:                       output_folder => $captcha_params{'output_dir'},
                   18653:                       data_folder   => $captcha_params{'db_dir'},
                   18654:                   );
1.1075.2.26  raeburn  18655:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  18656:     my %captcha_hash = (
                   18657:                         0       => 'Code not checked (file error)',
                   18658:                        -1      => 'Failed: code expired',
                   18659:                        -2      => 'Failed: invalid code (not in database)',
                   18660:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   18661:     );
                   18662:     if ($captcha_chk != 1) {
                   18663:         $captcha_error = $captcha_hash{$captcha_chk}
                   18664:     }
                   18665:     return ($captcha_chk,$captcha_error);
                   18666: }
                   18667: 
                   18668: sub create_recaptcha {
1.1075.2.107  raeburn  18669:     my ($pubkey,$version) = @_;
                   18670:     if ($version >= 2) {
1.1075.2.158  raeburn  18671:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
                   18672:                '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1075.2.107  raeburn  18673:     } else {
                   18674:         my $use_ssl;
                   18675:         if ($ENV{'SERVER_PORT'} == 443) {
                   18676:             $use_ssl = 1;
                   18677:         }
                   18678:         my $captcha = Captcha::reCAPTCHA->new;
                   18679:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   18680:                $captcha->get_html($pubkey,undef,$use_ssl).
                   18681:                &mt('If the text is hard to read, [_1] will replace them.',
                   18682:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   18683:                '<br /><br />';
                   18684:      }
1.1075.2.14  raeburn  18685: }
                   18686: 
                   18687: sub check_recaptcha {
1.1075.2.107  raeburn  18688:     my ($privkey,$version) = @_;
1.1075.2.14  raeburn  18689:     my $captcha_chk;
1.1075.2.150  raeburn  18690:     my $ip = &Apache::lonnet::get_requestor_ip(); 
1.1075.2.107  raeburn  18691:     if ($version >= 2) {
                   18692:         my $ua = LWP::UserAgent->new;
                   18693:         $ua->timeout(10);
                   18694:         my %info = (
                   18695:                      secret   => $privkey,
                   18696:                      response => $env{'form.g-recaptcha-response'},
1.1075.2.150  raeburn  18697:                      remoteip => $ip,
1.1075.2.107  raeburn  18698:                    );
                   18699:         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
                   18700:         if ($response->is_success)  {
                   18701:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   18702:             if (ref($data) eq 'HASH') {
                   18703:                 if ($data->{'success'}) {
                   18704:                     $captcha_chk = 1;
                   18705:                 }
                   18706:             }
                   18707:         }
                   18708:     } else {
                   18709:         my $captcha = Captcha::reCAPTCHA->new;
                   18710:         my $captcha_result =
                   18711:             $captcha->check_answer(
                   18712:                                     $privkey,
1.1075.2.150  raeburn  18713:                                     $ip,
1.1075.2.107  raeburn  18714:                                     $env{'form.recaptcha_challenge_field'},
                   18715:                                     $env{'form.recaptcha_response_field'},
                   18716:                                   );
                   18717:         if ($captcha_result->{is_valid}) {
                   18718:             $captcha_chk = 1;
                   18719:         }
1.1075.2.14  raeburn  18720:     }
                   18721:     return $captcha_chk;
                   18722: }
                   18723: 
1.1075.2.64  raeburn  18724: sub emailusername_info {
1.1075.2.103  raeburn  18725:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64  raeburn  18726:     my %titles = &Apache::lonlocal::texthash (
                   18727:                      lastname      => 'Last Name',
                   18728:                      firstname     => 'First Name',
                   18729:                      institution   => 'School/college/university',
                   18730:                      location      => "School's city, state/province, country",
                   18731:                      web           => "School's web address",
                   18732:                      officialemail => 'E-mail address at institution (if different)',
1.1075.2.103  raeburn  18733:                      id            => 'Student/Employee ID',
1.1075.2.64  raeburn  18734:                  );
                   18735:     return (\@fields,\%titles);
                   18736: }
                   18737: 
1.1075.2.56  raeburn  18738: sub cleanup_html {
                   18739:     my ($incoming) = @_;
                   18740:     my $outgoing;
                   18741:     if ($incoming ne '') {
                   18742:         $outgoing = $incoming;
                   18743:         $outgoing =~ s/;/&#059;/g;
                   18744:         $outgoing =~ s/\#/&#035;/g;
                   18745:         $outgoing =~ s/\&/&#038;/g;
                   18746:         $outgoing =~ s/</&#060;/g;
                   18747:         $outgoing =~ s/>/&#062;/g;
                   18748:         $outgoing =~ s/\(/&#040/g;
                   18749:         $outgoing =~ s/\)/&#041;/g;
                   18750:         $outgoing =~ s/"/&#034;/g;
                   18751:         $outgoing =~ s/'/&#039;/g;
                   18752:         $outgoing =~ s/\$/&#036;/g;
                   18753:         $outgoing =~ s{/}{&#047;}g;
                   18754:         $outgoing =~ s/=/&#061;/g;
                   18755:         $outgoing =~ s/\\/&#092;/g
                   18756:     }
                   18757:     return $outgoing;
                   18758: }
                   18759: 
1.1075.2.74  raeburn  18760: # Checks for critical messages and returns a redirect url if one exists.
                   18761: # $interval indicates how often to check for messages.
1.1075.2.161.  .1(raebu 18762:21): # $context is the calling context -- roles, grades, contents, menu or flip.
1.1075.2.74  raeburn  18763: sub critical_redirect {
1.1075.2.161.  .1(raebu 18764:21):     my ($interval,$context) = @_;
1.1075.2.158  raeburn  18765:     unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
                   18766:         return ();
                   18767:     }
1.1075.2.74  raeburn  18768:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1075.2.161.  .1(raebu 18769:21):         if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
                   18770:21):             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   18771:21):             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
          .4(raebu 18772:22):             my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
          .1(raebu 18773:21):             if ($blocked) {
                   18774:21):                 my $checkrole = "cm./$cdom/$cnum";
                   18775:21):                 if ($env{'request.course.sec'} ne '') {
                   18776:21):                     $checkrole .= "/$env{'request.course.sec'}";
                   18777:21):                 }
                   18778:21):                 unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   18779:21):                         ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   18780:21):                     return;
                   18781:21):                 }
                   18782:21):             }
                   18783:21):         }
1.1075.2.74  raeburn  18784:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   18785:                                         $env{'user.name'});
                   18786:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   18787:         my $redirecturl;
                   18788:         if ($what[0]) {
1.1075.2.158  raeburn  18789:             if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1075.2.74  raeburn  18790:                 $redirecturl='/adm/email?critical=display';
                   18791:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   18792:                 return (1, $url);
                   18793:             }
                   18794:         }
                   18795:     }
                   18796:     return ();
                   18797: }
                   18798: 
1.1075.2.64  raeburn  18799: # Use:
                   18800: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   18801: #
                   18802: ##################################################
                   18803: #          password associated functions         #
                   18804: ##################################################
                   18805: sub des_keys {
                   18806:     # Make a new key for DES encryption.
                   18807:     # Each key has two parts which are returned separately.
                   18808:     # Please note:  Each key must be passed through the &hex function
                   18809:     # before it is output to the web browser.  The hex versions cannot
                   18810:     # be used to decrypt.
                   18811:     my @hexstr=('0','1','2','3','4','5','6','7',
                   18812:                 '8','9','a','b','c','d','e','f');
                   18813:     my $lkey='';
                   18814:     for (0..7) {
                   18815:         $lkey.=$hexstr[rand(15)];
                   18816:     }
                   18817:     my $ukey='';
                   18818:     for (0..7) {
                   18819:         $ukey.=$hexstr[rand(15)];
                   18820:     }
                   18821:     return ($lkey,$ukey);
                   18822: }
                   18823: 
                   18824: sub des_decrypt {
                   18825:     my ($key,$cyphertext) = @_;
                   18826:     my $keybin=pack("H16",$key);
                   18827:     my $cypher;
                   18828:     if ($Crypt::DES::VERSION>=2.03) {
                   18829:         $cypher=new Crypt::DES $keybin;
                   18830:     } else {
                   18831:         $cypher=new DES $keybin;
                   18832:     }
1.1075.2.106  raeburn  18833:     my $plaintext='';
                   18834:     my $cypherlength = length($cyphertext);
                   18835:     my $numchunks = int($cypherlength/32);
                   18836:     for (my $j=0; $j<$numchunks; $j++) {
                   18837:         my $start = $j*32;
                   18838:         my $cypherblock = substr($cyphertext,$start,32);
                   18839:         my $chunk =
                   18840:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   18841:         $chunk .=
                   18842:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   18843:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   18844:         $plaintext .= $chunk;
                   18845:     }
1.1075.2.64  raeburn  18846:     return $plaintext;
                   18847: }
                   18848: 
1.1075.2.161.  .1(raebu 18849:21): sub get_requested_shorturls {
                   18850:21):     my ($cdom,$cnum,$navmap) = @_;
                   18851:21):     return unless (ref($navmap));
                   18852:21):     my ($numnew,$errors);
                   18853:21):     my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
                   18854:21):     if (@toshorten) {
                   18855:21):         my (%maps,%resources,%titles);
                   18856:21):         &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                   18857:21):                                                                'shorturls',$cdom,$cnum);
                   18858:21):         if (keys(%resources)) {
                   18859:21):             my %tocreate;
                   18860:21):             foreach my $item (sort {$a <=> $b} (@toshorten)) {
                   18861:21):                 my $symb = $resources{$item};
                   18862:21):                 if ($symb) {
                   18863:21):                     $tocreate{$cnum.'&'.$symb} = 1;
                   18864:21):                 }
                   18865:21):             }
                   18866:21):             if (keys(%tocreate)) {
                   18867:21):                 ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
                   18868:21):                                                       \%tocreate);
                   18869:21):             }
                   18870:21):         }
                   18871:21):     }
                   18872:21):     return ($numnew,$errors);
                   18873:21): }
                   18874:21): 
                   18875:21): sub make_short_symbs {
                   18876:21):     my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
                   18877:21):     my ($numnew,@errors);
                   18878:21):     if (ref($tocreateref) eq 'HASH') {
                   18879:21):         my %tocreate = %{$tocreateref};
                   18880:21):         if (keys(%tocreate)) {
                   18881:21):             my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
                   18882:21):             my $su = Short::URL->new(no_vowels => 1);
                   18883:21):             my $init = '';
                   18884:21):             my (%newunique,%addcourse,%courseonly,%failed);
                   18885:21):             # get lock on tiny db
                   18886:21):             my $now = time;
                   18887:21):             if ($lockuser eq '') {
                   18888:21):                 $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
                   18889:21):             }
                   18890:21):             my $lockhash = {
                   18891:21):                                 "lock\0$now" => $lockuser,
                   18892:21):                             };
                   18893:21):             my $tries = 0;
                   18894:21):             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
                   18895:21):             my ($code,$error);
                   18896:21):             while (($gotlock ne 'ok') && ($tries<3)) {
                   18897:21):                 $tries ++;
                   18898:21):                 sleep 1;
                   18899:21):                 $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
                   18900:21):             }
                   18901:21):             if ($gotlock eq 'ok') {
                   18902:21):                 $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
                   18903:21):                                        \%addcourse,\%courseonly,\%failed);
                   18904:21):                 if (keys(%failed)) {
                   18905:21):                     my $numfailed = scalar(keys(%failed));
                   18906:21):                     push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
                   18907:21):                 }
                   18908:21):                 if (keys(%newunique)) {
                   18909:21):                     my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
                   18910:21):                     if ($putres eq 'ok') {
                   18911:21):                         $numnew = scalar(keys(%newunique));
                   18912:21):                         my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
                   18913:21):                         unless ($newputres eq 'ok') {
                   18914:21):                             push(@errors,&mt('error: could not store course look-up of short URLs'));
                   18915:21):                         }
                   18916:21):                     } else {
                   18917:21):                         push(@errors,&mt('error: could not store unique six character URLs'));
                   18918:21):                     }
                   18919:21):                 }
                   18920:21):                 my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
                   18921:21):                 unless ($dellockres eq 'ok') {
                   18922:21):                     push(@errors,&mt('error: could not release lockfile'));
                   18923:21):                 }
                   18924:21):             } else {
                   18925:21):                 push(@errors,&mt('error: could not obtain lockfile'));
                   18926:21):             }
                   18927:21):             if (keys(%courseonly)) {
                   18928:21):                 my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
                   18929:21):                 if ($result ne 'ok') {
                   18930:21):                     push(@errors,&mt('error: could not update course look-up of short URLs'));
                   18931:21):                 }
                   18932:21):             }
                   18933:21):         }
                   18934:21):     }
                   18935:21):     return ($numnew,\@errors);
                   18936:21): }
                   18937:21): 
                   18938:21): sub shorten_symbs {
                   18939:21):     my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
                   18940:21):     return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
                   18941:21):                    (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
                   18942:21):                    (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
                   18943:21):     my (%possibles,%collisions);
                   18944:21):     foreach my $key (keys(%{$tocreate})) {
                   18945:21):         my $num = String::CRC32::crc32($key);
                   18946:21):         my $tiny = $su->encode($num,$init);
                   18947:21):         if ($tiny) {
                   18948:21):             $possibles{$tiny} = $key;
                   18949:21):         }
                   18950:21):     }
                   18951:21):     if (!$init) {
                   18952:21):         $init = 1;
                   18953:21):     } else {
                   18954:21):         $init ++;
                   18955:21):     }
                   18956:21):     if (keys(%possibles)) {
                   18957:21):         my @posstiny = keys(%possibles);
                   18958:21):         my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                   18959:21):         my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
                   18960:21):         if (keys(%currtiny)) {
                   18961:21):             foreach my $key (keys(%currtiny)) {
                   18962:21):                 next if ($currtiny{$key} eq '');
                   18963:21):                 if ($currtiny{$key} eq $possibles{$key}) {
                   18964:21):                     my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
                   18965:21):                     unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                   18966:21):                         $courseonly->{$tsymb} = $key;
                   18967:21):                     }
                   18968:21):                 } else {
                   18969:21):                     $collisions{$possibles{$key}} = 1;
                   18970:21):                 }
                   18971:21):                 delete($possibles{$key});
                   18972:21):             }
                   18973:21):         }
                   18974:21):         foreach my $key (keys(%possibles)) {
                   18975:21):             $newunique->{$key} = $possibles{$key};
                   18976:21):             my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
                   18977:21):             unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                   18978:21):                 $addcourse->{$tsymb} = $key;
                   18979:21):             }
                   18980:21):         }
                   18981:21):     }
                   18982:21):     if (keys(%collisions)) {
                   18983:21):         if ($init <5) {
                   18984:21):             if (!$init) {
                   18985:21):                 $init = 1;
                   18986:21):             } else {
                   18987:21):                 $init ++;
                   18988:21):             }
                   18989:21):             $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
                   18990:21):                                    $newunique,$addcourse,$courseonly,$failed);
                   18991:21):         } else {
                   18992:21):             foreach my $key (keys(%collisions)) {
                   18993:21):                 $failed->{$key} = 1;
                   18994:21):                 $failed->{$key} = 1;
                   18995:21):             }
                   18996:21):         }
                   18997:21):     }
                   18998:21):     return $init;
                   18999:21): }
                   19000:21): 
1.1075.2.135  raeburn  19001: sub is_nonframeable {
                   19002:     my ($url,$absolute,$hostname,$ip,$nocache) = @_;
                   19003:     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
                   19004:     return if (($remprotocol eq '') || ($remhost eq ''));
                   19005: 
                   19006:     $remprotocol = lc($remprotocol);
                   19007:     $remhost = lc($remhost);
                   19008:     my $remport = 80;
                   19009:     if ($remprotocol eq 'https') {
                   19010:         $remport = 443;
                   19011:     }
                   19012:     my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
                   19013:     if ($cached) {
                   19014:         unless ($nocache) {
                   19015:             if ($result) {
                   19016:                 return 1;
                   19017:             } else {
                   19018:                 return 0;
                   19019:             }
                   19020:         }
                   19021:     }
                   19022:     my $uselink;
                   19023:     my $request = new HTTP::Request('HEAD',$url);
1.1075.2.142  raeburn  19024:     my $ua = LWP::UserAgent->new;
                   19025:     $ua->timeout(5);
                   19026:     my $response=$ua->request($request);
1.1075.2.135  raeburn  19027:     if ($response->is_success()) {
                   19028:         my $secpolicy = lc($response->header('content-security-policy'));
                   19029:         my $xframeop = lc($response->header('x-frame-options'));
                   19030:         $secpolicy =~ s/^\s+|\s+$//g;
                   19031:         $xframeop =~ s/^\s+|\s+$//g;
                   19032:         if (($secpolicy ne '') || ($xframeop ne '')) {
                   19033:             my $remotehost = $remprotocol.'://'.$remhost;
                   19034:             my ($origin,$protocol,$port);
                   19035:             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                   19036:                 $port = $ENV{'SERVER_PORT'};
                   19037:             } else {
                   19038:                 $port = 80;
                   19039:             }
                   19040:             if ($absolute eq '') {
                   19041:                 $protocol = 'http:';
                   19042:                 if ($port == 443) {
                   19043:                     $protocol = 'https:';
                   19044:                 }
                   19045:                 $origin = $protocol.'//'.lc($hostname);
                   19046:             } else {
                   19047:                 $origin = lc($absolute);
                   19048:                 ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
                   19049:             }
                   19050:             if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
                   19051:                 my $framepolicy = $1;
                   19052:                 $framepolicy =~ s/^\s+|\s+$//g;
                   19053:                 my @policies = split(/\s+/,$framepolicy);
                   19054:                 if (@policies) {
                   19055:                     if (grep(/^\Q'none'\E$/,@policies)) {
                   19056:                         $uselink = 1;
                   19057:                     } else {
                   19058:                         $uselink = 1;
                   19059:                         if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
                   19060:                                 (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
                   19061:                                 (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
                   19062:                             undef($uselink);
                   19063:                         }
                   19064:                         if ($uselink) {
                   19065:                             if (grep(/^\Q'self'\E$/,@policies)) {
                   19066:                                 if (($origin ne '') && ($remotehost eq $origin)) {
                   19067:                                     undef($uselink);
                   19068:                                 }
                   19069:                             }
                   19070:                         }
                   19071:                         if ($uselink) {
                   19072:                             my @possok;
                   19073:                             if ($ip ne '') {
                   19074:                                 push(@possok,$ip);
                   19075:                             }
                   19076:                             my $hoststr = '';
                   19077:                             foreach my $part (reverse(split(/\./,$hostname))) {
                   19078:                                 if ($hoststr eq '') {
                   19079:                                     $hoststr = $part;
                   19080:                                 } else {
                   19081:                                     $hoststr = "$part.$hoststr";
                   19082:                                 }
                   19083:                                 if ($hoststr eq $hostname) {
                   19084:                                     push(@possok,$hostname);
                   19085:                                 } else {
                   19086:                                     push(@possok,"*.$hoststr");
                   19087:                                 }
                   19088:                             }
                   19089:                             if (@possok) {
                   19090:                                 foreach my $poss (@possok) {
                   19091:                                     last if (!$uselink);
                   19092:                                     foreach my $policy (@policies) {
                   19093:                                         if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
                   19094:                                             undef($uselink);
                   19095:                                             last;
                   19096:                                         }
                   19097:                                     }
                   19098:                                 }
                   19099:                             }
                   19100:                         }
                   19101:                     }
                   19102:                 }
                   19103:             } elsif ($xframeop ne '') {
                   19104:                 $uselink = 1;
                   19105:                 my @policies = split(/\s*,\s*/,$xframeop);
                   19106:                 if (@policies) {
                   19107:                     unless (grep(/^deny$/,@policies)) {
                   19108:                         if ($origin ne '') {
                   19109:                             if (grep(/^sameorigin$/,@policies)) {
                   19110:                                 if ($remotehost eq $origin) {
                   19111:                                     undef($uselink);
                   19112:                                 }
                   19113:                             }
                   19114:                             if ($uselink) {
                   19115:                                 foreach my $policy (@policies) {
                   19116:                                     if ($policy =~ /^allow-from\s*(.+)$/) {
                   19117:                                         my $allowfrom = $1;
                   19118:                                         if (($allowfrom ne '') && ($allowfrom eq $origin)) {
                   19119:                                             undef($uselink);
                   19120:                                             last;
                   19121:                                         }
                   19122:                                     }
                   19123:                                 }
                   19124:                             }
                   19125:                         }
                   19126:                     }
                   19127:                 }
                   19128:             }
                   19129:         }
                   19130:     }
                   19131:     if ($nocache) {
                   19132:         if ($cached) {
                   19133:             my $devalidate;
                   19134:             if ($uselink && !$result) {
                   19135:                 $devalidate = 1;
                   19136:             } elsif (!$uselink && $result) {
                   19137:                 $devalidate = 1;
                   19138:             }
                   19139:             if ($devalidate) {
                   19140:                 &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
                   19141:             }
                   19142:         }
                   19143:     } else {
                   19144:         if ($uselink) {
                   19145:             $result = 1;
                   19146:         } else {
                   19147:             $result = 0;
                   19148:         }
                   19149:         &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
                   19150:     }
                   19151:     return $uselink;
                   19152: }
                   19153: 
1.1075.2.161.  .1(raebu 19154:21): sub page_menu {
                   19155:21):     my ($menucolls,$menunum) = @_;
                   19156:21):     my %menu;
                   19157:21):     foreach my $item (split(/;/,$menucolls)) {
                   19158:21):         my ($num,$value) = split(/\%/,$item);
                   19159:21):         if ($num eq $menunum) {
                   19160:21):             my @entries = split(/\&/,$value);
                   19161:21):             foreach my $entry (@entries) {
                   19162:21):                 my ($name,$fields) = split(/=/,$entry);
                   19163:21):                 if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
                   19164:21):                     $menu{$name} = $fields;
                   19165:21):                 } else {
                   19166:21):                     my @shown;
                   19167:21):                     if ($fields =~ /,/) {
                   19168:21):                         @shown = split(/,/,$fields);
                   19169:21):                     } else {
                   19170:21):                         @shown = ($fields);
                   19171:21):                     }
                   19172:21):                     if (@shown) {
                   19173:21):                         foreach my $field (@shown) {
                   19174:21):                             next if ($field eq '');
                   19175:21):                             $menu{$field} = 1;
                   19176:21):                         }
                   19177:21):                     }
                   19178:21):                 }
                   19179:21):             }
                   19180:21):         }
                   19181:21):     }
                   19182:21):     return %menu;
                   19183:21): }
                   19184:21): 
1.112     bowersj2 19185: 1;
                   19186: __END__;
1.41      ng       19187: 

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