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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1092  ! raeburn     4: # $Id: loncommon.pm,v 1.1091 2012/08/14 10:22:25 foxr Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.479     albertel   70: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    71: use DateTime::TimeZone;
1.687     raeburn    72: use DateTime::Locale::Catalog;
1.1091    foxr       73: use Text::Aspell;
1.117     www        74: 
1.517     raeburn    75: # ---------------------------------------------- Designs
                     76: use vars qw(%defaultdesign);
                     77: 
1.22      www        78: my $readit;
                     79: 
1.517     raeburn    80: 
1.157     matthew    81: ##
                     82: ## Global Variables
                     83: ##
1.46      matthew    84: 
1.643     foxr       85: 
                     86: # ----------------------------------------------- SSI with retries:
                     87: #
                     88: 
                     89: =pod
                     90: 
1.648     raeburn    91: =head1 Server Side include with retries:
1.643     foxr       92: 
                     93: =over 4
                     94: 
1.648     raeburn    95: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       96: 
                     97: Performs an ssi with some number of retries.  Retries continue either
                     98: until the result is ok or until the retry count supplied by the
                     99: caller is exhausted.  
                    100: 
                    101: Inputs:
1.648     raeburn   102: 
                    103: =over 4
                    104: 
1.643     foxr      105: resource   - Identifies the resource to insert.
1.648     raeburn   106: 
1.643     foxr      107: retries    - Count of the number of retries allowed.
1.648     raeburn   108: 
1.643     foxr      109: form       - Hash that identifies the rendering options.
                    110: 
1.648     raeburn   111: =back
                    112: 
                    113: Returns:
                    114: 
                    115: =over 4
                    116: 
1.643     foxr      117: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   118: 
1.643     foxr      119: response   - The response from the last attempt (which may or may not have been successful.
                    120: 
1.648     raeburn   121: =back
                    122: 
                    123: =back
                    124: 
1.643     foxr      125: =cut
                    126: 
                    127: sub ssi_with_retries {
                    128:     my ($resource, $retries, %form) = @_;
                    129: 
                    130: 
                    131:     my $ok = 0;			# True if we got a good response.
                    132:     my $content;
                    133:     my $response;
                    134: 
                    135:     # Try to get the ssi done. within the retries count:
                    136: 
                    137:     do {
                    138: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    139: 	$ok      = $response->is_success;
1.650     www       140:         if (!$ok) {
                    141:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    142:         }
1.643     foxr      143: 	$retries--;
                    144:     } while (!$ok && ($retries > 0));
                    145: 
                    146:     if (!$ok) {
                    147: 	$content = '';		# On error return an empty content.
                    148:     }
                    149:     return ($content, $response);
                    150: 
                    151: }
                    152: 
                    153: 
                    154: 
1.20      www       155: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  156: my %language;
1.124     www       157: my %supported_language;
1.1088    foxr      158: my %supported_codes;
1.1048    foxr      159: my %latex_language;		# For choosing hyphenation in <transl..>
                    160: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  161: my %cprtag;
1.192     taceyjo1  162: my %scprtag;
1.351     www       163: my %fe; my %fd; my %fm;
1.41      ng        164: my %category_extensions;
1.12      harris41  165: 
1.46      matthew   166: # ---------------------------------------------- Thesaurus variables
1.144     matthew   167: #
                    168: # %Keywords:
                    169: #      A hash used by &keyword to determine if a word is considered a keyword.
                    170: # $thesaurus_db_file 
                    171: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   172: 
                    173: my %Keywords;
                    174: my $thesaurus_db_file;
                    175: 
1.144     matthew   176: #
                    177: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    178: # thesaurus.tab, and filecategories.tab.
                    179: #
1.18      www       180: BEGIN {
1.46      matthew   181:     # Variable initialization
                    182:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    183:     #
1.22      www       184:     unless ($readit) {
1.12      harris41  185: # ------------------------------------------------------------------- languages
                    186:     {
1.158     raeburn   187:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    188:                                    '/language.tab';
                    189:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  190:             while (my $line = <$fh>) {
                    191:                 next if ($line=~/^\#/);
                    192:                 chomp($line);
1.1088    foxr      193:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   194:                 $language{$key}=$val.' - '.$enc;
                    195:                 if ($sup) {
                    196:                     $supported_language{$key}=$sup;
1.1088    foxr      197: 		    $supported_codes{$key}   = $code;
1.158     raeburn   198:                 }
1.1048    foxr      199: 		if ($latex) {
                    200: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      201: 		    $latex_language{$code} = $latex;
1.1048    foxr      202: 		}
1.158     raeburn   203:             }
                    204:             close($fh);
                    205:         }
1.12      harris41  206:     }
                    207: # ------------------------------------------------------------------ copyrights
                    208:     {
1.158     raeburn   209:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    210:                                   '/copyright.tab';
                    211:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  212:             while (my $line = <$fh>) {
                    213:                 next if ($line=~/^\#/);
                    214:                 chomp($line);
                    215:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   216:                 $cprtag{$key}=$val;
                    217:             }
                    218:             close($fh);
                    219:         }
1.12      harris41  220:     }
1.351     www       221: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  222:     {
                    223:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    224:                                   '/source_copyright.tab';
                    225:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  226:             while (my $line = <$fh>) {
                    227:                 next if ($line =~ /^\#/);
                    228:                 chomp($line);
                    229:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  230:                 $scprtag{$key}=$val;
                    231:             }
                    232:             close($fh);
                    233:         }
                    234:     }
1.63      www       235: 
1.517     raeburn   236: # -------------------------------------------------------------- default domain designs
1.63      www       237:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   238:     my $designfile = $designdir.'/default.tab';
                    239:     if ( open (my $fh,"<$designfile") ) {
                    240:         while (my $line = <$fh>) {
                    241:             next if ($line =~ /^\#/);
                    242:             chomp($line);
                    243:             my ($key,$val)=(split(/\=/,$line));
                    244:             if ($val) { $defaultdesign{$key}=$val; }
                    245:         }
                    246:         close($fh);
1.63      www       247:     }
                    248: 
1.15      harris41  249: # ------------------------------------------------------------- file categories
                    250:     {
1.158     raeburn   251:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    252:                                   '/filecategories.tab';
                    253:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  254: 	    while (my $line = <$fh>) {
                    255: 		next if ($line =~ /^\#/);
                    256: 		chomp($line);
                    257:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   258:                 push @{$category_extensions{lc($category)}},$extension;
                    259:             }
                    260:             close($fh);
                    261:         }
                    262: 
1.15      harris41  263:     }
1.12      harris41  264: # ------------------------------------------------------------------ file types
                    265:     {
1.158     raeburn   266:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    267:                '/filetypes.tab';
                    268:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  269:             while (my $line = <$fh>) {
                    270: 		next if ($line =~ /^\#/);
                    271: 		chomp($line);
                    272:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   273:                 if ($descr ne '') {
                    274:                     $fe{$ending}=lc($emb);
                    275:                     $fd{$ending}=$descr;
1.351     www       276:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   277:                 }
                    278:             }
                    279:             close($fh);
                    280:         }
1.12      harris41  281:     }
1.22      www       282:     &Apache::lonnet::logthis(
1.705     tempelho  283:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       284:     $readit=1;
1.46      matthew   285:     }  # end of unless($readit) 
1.32      matthew   286:     
                    287: }
1.112     bowersj2  288: 
1.42      matthew   289: ###############################################################
                    290: ##           HTML and Javascript Helper Functions            ##
                    291: ###############################################################
                    292: 
                    293: =pod 
                    294: 
1.112     bowersj2  295: =head1 HTML and Javascript Functions
1.42      matthew   296: 
1.112     bowersj2  297: =over 4
                    298: 
1.648     raeburn   299: =item * &browser_and_searcher_javascript()
1.112     bowersj2  300: 
                    301: X<browsing, javascript>X<searching, javascript>Returns a string
                    302: containing javascript with two functions, C<openbrowser> and
                    303: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    304: tags.
1.42      matthew   305: 
1.648     raeburn   306: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   307: 
                    308: inputs: formname, elementname, only, omit
                    309: 
                    310: formname and elementname indicate the name of the html form and name of
                    311: the element that the results of the browsing selection are to be placed in. 
                    312: 
                    313: Specifying 'only' will restrict the browser to displaying only files
1.185     www       314: with the given extension.  Can be a comma separated list.
1.42      matthew   315: 
                    316: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       317: with the given extension.  Can be a comma separated list.
1.42      matthew   318: 
1.648     raeburn   319: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   320: 
                    321: Inputs: formname, elementname
                    322: 
                    323: formname and elementname specify the name of the html form and the name
                    324: of the element the selection from the search results will be placed in.
1.542     raeburn   325: 
1.42      matthew   326: =cut
                    327: 
                    328: sub browser_and_searcher_javascript {
1.199     albertel  329:     my ($mode)=@_;
                    330:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  331:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   332:     return <<END;
1.219     albertel  333: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   334:     var editbrowser = null;
1.135     albertel  335:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       336:         var url = '$resurl/?';
1.42      matthew   337:         if (editbrowser == null) {
                    338:             url += 'launch=1&';
                    339:         }
                    340:         url += 'catalogmode=interactive&';
1.199     albertel  341:         url += 'mode=$mode&';
1.611     albertel  342:         url += 'inhibitmenu=yes&';
1.42      matthew   343:         url += 'form=' + formname + '&';
                    344:         if (only != null) {
                    345:             url += 'only=' + only + '&';
1.217     albertel  346:         } else {
                    347:             url += 'only=&';
                    348: 	}
1.42      matthew   349:         if (omit != null) {
                    350:             url += 'omit=' + omit + '&';
1.217     albertel  351:         } else {
                    352:             url += 'omit=&';
                    353: 	}
1.135     albertel  354:         if (titleelement != null) {
                    355:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  356:         } else {
                    357: 	    url += 'titleelement=&';
                    358: 	}
1.42      matthew   359:         url += 'element=' + elementname + '';
                    360:         var title = 'Browser';
1.435     albertel  361:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   362:         options += ',width=700,height=600';
                    363:         editbrowser = open(url,title,options,'1');
                    364:         editbrowser.focus();
                    365:     }
                    366:     var editsearcher;
1.135     albertel  367:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   368:         var url = '/adm/searchcat?';
                    369:         if (editsearcher == null) {
                    370:             url += 'launch=1&';
                    371:         }
                    372:         url += 'catalogmode=interactive&';
1.199     albertel  373:         url += 'mode=$mode&';
1.42      matthew   374:         url += 'form=' + formname + '&';
1.135     albertel  375:         if (titleelement != null) {
                    376:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  377:         } else {
                    378: 	    url += 'titleelement=&';
                    379: 	}
1.42      matthew   380:         url += 'element=' + elementname + '';
                    381:         var title = 'Search';
1.435     albertel  382:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   383:         options += ',width=700,height=600';
                    384:         editsearcher = open(url,title,options,'1');
                    385:         editsearcher.focus();
                    386:     }
1.219     albertel  387: // END LON-CAPA Internal -->
1.42      matthew   388: END
1.170     www       389: }
                    390: 
                    391: sub lastresurl {
1.258     albertel  392:     if ($env{'environment.lastresurl'}) {
                    393: 	return $env{'environment.lastresurl'}
1.170     www       394:     } else {
                    395: 	return '/res';
                    396:     }
                    397: }
                    398: 
                    399: sub storeresurl {
                    400:     my $resurl=&Apache::lonnet::clutter(shift);
                    401:     unless ($resurl=~/^\/res/) { return 0; }
                    402:     $resurl=~s/\/$//;
                    403:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   404:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       405:     return 1;
1.42      matthew   406: }
                    407: 
1.74      www       408: sub studentbrowser_javascript {
1.111     www       409:    unless (
1.258     albertel  410:             (($env{'request.course.id'}) && 
1.302     albertel  411:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    412: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    413: 					  '/'.$env{'request.course.sec'})
                    414: 	      ))
1.258     albertel  415:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       416:           ) { return ''; }  
1.74      www       417:    return (<<'ENDSTDBRW');
1.776     bisitz    418: <script type="text/javascript" language="Javascript">
1.824     bisitz    419: // <![CDATA[
1.74      www       420:     var stdeditbrowser;
1.999     www       421:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       422:         var url = '/adm/pickstudent?';
                    423:         var filter;
1.558     albertel  424: 	if (!ignorefilter) {
                    425: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    426: 	}
1.74      www       427:         if (filter != null) {
                    428:            if (filter != '') {
                    429:                url += 'filter='+filter+'&';
                    430: 	   }
                    431:         }
                    432:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       433:                                     '&udomelement='+udom+
                    434:                                     '&clicker='+clicker;
1.111     www       435: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   436:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       437:         var title = 'Student_Browser';
1.74      www       438:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    439:         options += ',width=700,height=600';
                    440:         stdeditbrowser = open(url,title,options,'1');
                    441:         stdeditbrowser.focus();
                    442:     }
1.824     bisitz    443: // ]]>
1.74      www       444: </script>
                    445: ENDSTDBRW
                    446: }
1.42      matthew   447: 
1.1003    www       448: sub resourcebrowser_javascript {
                    449:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       450:    return (<<'ENDRESBRW');
1.1003    www       451: <script type="text/javascript" language="Javascript">
                    452: // <![CDATA[
                    453:     var reseditbrowser;
1.1004    www       454:     function openresbrowser(formname,reslink) {
1.1005    www       455:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       456:         var title = 'Resource_Browser';
                    457:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       458:         options += ',width=700,height=500';
1.1004    www       459:         reseditbrowser = open(url,title,options,'1');
                    460:         reseditbrowser.focus();
1.1003    www       461:     }
                    462: // ]]>
                    463: </script>
1.1004    www       464: ENDRESBRW
1.1003    www       465: }
                    466: 
1.74      www       467: sub selectstudent_link {
1.999     www       468:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    469:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    470:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    471:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  472:    if ($env{'request.course.id'}) {  
1.302     albertel  473:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    474: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    475: 					'/'.$env{'request.course.sec'})) {
1.111     www       476: 	   return '';
                    477:        }
1.999     www       478:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   479:        if ($courseadvonly)  {
                    480:            $callargs .= ",'',1,1";
                    481:        }
                    482:        return '<span class="LC_nobreak">'.
                    483:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    484:               &mt('Select User').'</a></span>';
1.74      www       485:    }
1.258     albertel  486:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       487:        $callargs .= ",'',1"; 
1.793     raeburn   488:        return '<span class="LC_nobreak">'.
                    489:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    490:               &mt('Select User').'</a></span>';
1.111     www       491:    }
                    492:    return '';
1.91      www       493: }
                    494: 
1.1004    www       495: sub selectresource_link {
                    496:    my ($form,$reslink,$arg)=@_;
                    497:    
                    498:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    499:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    500:    unless ($env{'request.course.id'}) { return $arg; }
                    501:    return '<span class="LC_nobreak">'.
                    502:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    503:               $arg.'</a></span>';
                    504: }
                    505: 
                    506: 
                    507: 
1.653     raeburn   508: sub authorbrowser_javascript {
                    509:     return <<"ENDAUTHORBRW";
1.776     bisitz    510: <script type="text/javascript" language="JavaScript">
1.824     bisitz    511: // <![CDATA[
1.653     raeburn   512: var stdeditbrowser;
                    513: 
                    514: function openauthorbrowser(formname,udom) {
                    515:     var url = '/adm/pickauthor?';
                    516:     url += 'form='+formname+'&roledom='+udom;
                    517:     var title = 'Author_Browser';
                    518:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    519:     options += ',width=700,height=600';
                    520:     stdeditbrowser = open(url,title,options,'1');
                    521:     stdeditbrowser.focus();
                    522: }
                    523: 
1.824     bisitz    524: // ]]>
1.653     raeburn   525: </script>
                    526: ENDAUTHORBRW
                    527: }
                    528: 
1.91      www       529: sub coursebrowser_javascript {
1.909     raeburn   530:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932     raeburn   531:     my $wintitle = 'Course_Browser';
1.931     raeburn   532:     if ($crstype eq 'Community') {
1.932     raeburn   533:         $wintitle = 'Community_Browser';
1.909     raeburn   534:     }
1.876     raeburn   535:     my $id_functions = &javascript_index_functions();
                    536:     my $output = '
1.776     bisitz    537: <script type="text/javascript" language="JavaScript">
1.824     bisitz    538: // <![CDATA[
1.468     raeburn   539:     var stdeditbrowser;'."\n";
1.876     raeburn   540: 
                    541:     $output .= <<"ENDSTDBRW";
1.909     raeburn   542:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       543:         var url = '/adm/pickcourse?';
1.895     raeburn   544:         var formid = getFormIdByName(formname);
1.876     raeburn   545:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  546:         if (domainfilter != null) {
                    547:            if (domainfilter != '') {
                    548:                url += 'domainfilter='+domainfilter+'&';
                    549: 	   }
                    550:         }
1.91      www       551:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  552: 	                            '&cdomelement='+udom+
                    553:                                     '&cnameelement='+desc;
1.468     raeburn   554:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   555:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   556:                 url += '&roleelement='+extra_element;
                    557:                 if (domainfilter == null || domainfilter == '') {
                    558:                     url += '&domainfilter='+extra_element;
                    559:                 }
1.234     raeburn   560:             }
1.468     raeburn   561:             else {
                    562:                 if (formname == 'portform') {
                    563:                     url += '&setroles='+extra_element;
1.800     raeburn   564:                 } else {
                    565:                     if (formname == 'rules') {
                    566:                         url += '&fixeddom='+extra_element; 
                    567:                     }
1.468     raeburn   568:                 }
                    569:             }     
1.230     raeburn   570:         }
1.909     raeburn   571:         if (type != null && type != '') {
                    572:             url += '&type='+type;
                    573:         }
                    574:         if (type_elem != null && type_elem != '') {
                    575:             url += '&typeelement='+type_elem;
                    576:         }
1.872     raeburn   577:         if (formname == 'ccrs') {
                    578:             var ownername = document.forms[formid].ccuname.value;
                    579:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    580:             url += '&cloner='+ownername+':'+ownerdom;
                    581:         }
1.293     raeburn   582:         if (multflag !=null && multflag != '') {
                    583:             url += '&multiple='+multflag;
                    584:         }
1.909     raeburn   585:         var title = '$wintitle';
1.91      www       586:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    587:         options += ',width=700,height=600';
                    588:         stdeditbrowser = open(url,title,options,'1');
                    589:         stdeditbrowser.focus();
                    590:     }
1.876     raeburn   591: $id_functions
                    592: ENDSTDBRW
1.905     raeburn   593:     if (($sec_element ne '') || ($role_element ne '')) {
                    594:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   595:     }
                    596:     $output .= '
                    597: // ]]>
                    598: </script>';
                    599:     return $output;
                    600: }
                    601: 
                    602: sub javascript_index_functions {
                    603:     return <<"ENDJS";
                    604: 
                    605: function getFormIdByName(formname) {
                    606:     for (var i=0;i<document.forms.length;i++) {
                    607:         if (document.forms[i].name == formname) {
                    608:             return i;
                    609:         }
                    610:     }
                    611:     return -1;
                    612: }
                    613: 
                    614: function getIndexByName(formid,item) {
                    615:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    616:         if (document.forms[formid].elements[i].name == item) {
                    617:             return i;
                    618:         }
                    619:     }
                    620:     return -1;
                    621: }
1.468     raeburn   622: 
1.876     raeburn   623: function getDomainFromSelectbox(formname,udom) {
                    624:     var userdom;
                    625:     var formid = getFormIdByName(formname);
                    626:     if (formid > -1) {
                    627:         var domid = getIndexByName(formid,udom);
                    628:         if (domid > -1) {
                    629:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    630:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    631:             }
                    632:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    633:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   634:             }
                    635:         }
                    636:     }
1.876     raeburn   637:     return userdom;
                    638: }
                    639: 
                    640: ENDJS
1.468     raeburn   641: 
1.876     raeburn   642: }
                    643: 
1.1017    raeburn   644: sub javascript_array_indexof {
1.1018    raeburn   645:     return <<ENDJS;
1.1017    raeburn   646: <script type="text/javascript" language="JavaScript">
                    647: // <![CDATA[
                    648: 
                    649: if (!Array.prototype.indexOf) {
                    650:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    651:         "use strict";
                    652:         if (this === void 0 || this === null) {
                    653:             throw new TypeError();
                    654:         }
                    655:         var t = Object(this);
                    656:         var len = t.length >>> 0;
                    657:         if (len === 0) {
                    658:             return -1;
                    659:         }
                    660:         var n = 0;
                    661:         if (arguments.length > 0) {
                    662:             n = Number(arguments[1]);
1.1088    foxr      663:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   664:                 n = 0;
                    665:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    666:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    667:             }
                    668:         }
                    669:         if (n >= len) {
                    670:             return -1;
                    671:         }
                    672:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    673:         for (; k < len; k++) {
                    674:             if (k in t && t[k] === searchElement) {
                    675:                 return k;
                    676:             }
                    677:         }
                    678:         return -1;
                    679:     }
                    680: }
                    681: 
                    682: // ]]>
                    683: </script>
                    684: 
                    685: ENDJS
                    686: 
                    687: }
                    688: 
1.876     raeburn   689: sub userbrowser_javascript {
                    690:     my $id_functions = &javascript_index_functions();
                    691:     return <<"ENDUSERBRW";
                    692: 
1.888     raeburn   693: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   694:     var url = '/adm/pickuser?';
                    695:     var userdom = getDomainFromSelectbox(formname,udom);
                    696:     if (userdom != null) {
                    697:        if (userdom != '') {
                    698:            url += 'srchdom='+userdom+'&';
                    699:        }
                    700:     }
                    701:     url += 'form=' + formname + '&unameelement='+uname+
                    702:                                 '&udomelement='+udom+
                    703:                                 '&ulastelement='+ulast+
                    704:                                 '&ufirstelement='+ufirst+
                    705:                                 '&uemailelement='+uemail+
1.881     raeburn   706:                                 '&hideudomelement='+hideudom+
                    707:                                 '&coursedom='+crsdom;
1.888     raeburn   708:     if ((caller != null) && (caller != undefined)) {
                    709:         url += '&caller='+caller;
                    710:     }
1.876     raeburn   711:     var title = 'User_Browser';
                    712:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    713:     options += ',width=700,height=600';
                    714:     var stdeditbrowser = open(url,title,options,'1');
                    715:     stdeditbrowser.focus();
                    716: }
                    717: 
1.888     raeburn   718: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   719:     var formid = getFormIdByName(formname);
                    720:     if (formid > -1) {
1.888     raeburn   721:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   722:         var domid = getIndexByName(formid,udom);
                    723:         var hidedomid = getIndexByName(formid,origdom);
                    724:         if (hidedomid > -1) {
                    725:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   726:             var unameval = document.forms[formid].elements[unameid].value;
                    727:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    728:                 if (domid > -1) {
                    729:                     var slct = document.forms[formid].elements[domid];
                    730:                     if (slct.type == 'select-one') {
                    731:                         var i;
                    732:                         for (i=0;i<slct.length;i++) {
                    733:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    734:                         }
                    735:                     }
                    736:                     if (slct.type == 'hidden') {
                    737:                         slct.value = fixeddom;
1.876     raeburn   738:                     }
                    739:                 }
1.468     raeburn   740:             }
                    741:         }
                    742:     }
1.876     raeburn   743:     return;
                    744: }
                    745: 
                    746: $id_functions
                    747: ENDUSERBRW
1.468     raeburn   748: }
                    749: 
                    750: sub setsec_javascript {
1.905     raeburn   751:     my ($sec_element,$formname,$role_element) = @_;
                    752:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    753:         $communityrolestr);
                    754:     if ($role_element ne '') {
                    755:         my @allroles = ('st','ta','ep','in','ad');
                    756:         foreach my $crstype ('Course','Community') {
                    757:             if ($crstype eq 'Community') {
                    758:                 foreach my $role (@allroles) {
                    759:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    760:                 }
                    761:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    762:             } else {
                    763:                 foreach my $role (@allroles) {
                    764:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    765:                 }
                    766:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    767:             }
                    768:         }
                    769:         $rolestr = '"'.join('","',@allroles).'"';
                    770:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    771:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    772:     }
1.468     raeburn   773:     my $setsections = qq|
                    774: function setSect(sectionlist) {
1.629     raeburn   775:     var sectionsArray = new Array();
                    776:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    777:         sectionsArray = sectionlist.split(",");
                    778:     }
1.468     raeburn   779:     var numSections = sectionsArray.length;
                    780:     document.$formname.$sec_element.length = 0;
                    781:     if (numSections == 0) {
                    782:         document.$formname.$sec_element.multiple=false;
                    783:         document.$formname.$sec_element.size=1;
                    784:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    785:     } else {
                    786:         if (numSections == 1) {
                    787:             document.$formname.$sec_element.multiple=false;
                    788:             document.$formname.$sec_element.size=1;
                    789:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    790:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    791:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    792:         } else {
                    793:             for (var i=0; i<numSections; i++) {
                    794:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    795:             }
                    796:             document.$formname.$sec_element.multiple=true
                    797:             if (numSections < 3) {
                    798:                 document.$formname.$sec_element.size=numSections;
                    799:             } else {
                    800:                 document.$formname.$sec_element.size=3;
                    801:             }
                    802:             document.$formname.$sec_element.options[0].selected = false
                    803:         }
                    804:     }
1.91      www       805: }
1.905     raeburn   806: 
                    807: function setRole(crstype) {
1.468     raeburn   808: |;
1.905     raeburn   809:     if ($role_element eq '') {
                    810:         $setsections .= '    return;
                    811: }
                    812: ';
                    813:     } else {
                    814:         $setsections .= qq|
                    815:     var elementLength = document.$formname.$role_element.length;
                    816:     var allroles = Array($rolestr);
                    817:     var courserolenames = Array($courserolestr);
                    818:     var communityrolenames = Array($communityrolestr);
                    819:     if (elementLength != undefined) {
                    820:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    821:             if (crstype == 'Course') {
                    822:                 return;
                    823:             } else {
                    824:                 allroles[5] = 'co';
                    825:                 for (var i=0; i<6; i++) {
                    826:                     document.$formname.$role_element.options[i].value = allroles[i];
                    827:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    828:                 }
                    829:             }
                    830:         } else {
                    831:             if (crstype == 'Community') {
                    832:                 return;
                    833:             } else {
                    834:                 allroles[5] = 'cc';
                    835:                 for (var i=0; i<6; i++) {
                    836:                     document.$formname.$role_element.options[i].value = allroles[i];
                    837:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    838:                 }
                    839:             }
                    840:         }
                    841:     }
                    842:     return;
                    843: }
                    844: |;
                    845:     }
1.468     raeburn   846:     return $setsections;
                    847: }
                    848: 
1.91      www       849: sub selectcourse_link {
1.909     raeburn   850:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    851:        $typeelement) = @_;
                    852:    my $type = $selecttype;
1.871     raeburn   853:    my $linktext = &mt('Select Course');
                    854:    if ($selecttype eq 'Community') {
1.909     raeburn   855:        $linktext = &mt('Select Community');
1.906     raeburn   856:    } elsif ($selecttype eq 'Course/Community') {
                    857:        $linktext = &mt('Select Course/Community');
1.909     raeburn   858:        $type = '';
1.1019    raeburn   859:    } elsif ($selecttype eq 'Select') {
                    860:        $linktext = &mt('Select');
                    861:        $type = '';
1.871     raeburn   862:    }
1.787     bisitz    863:    return '<span class="LC_nobreak">'
                    864:          ."<a href='"
                    865:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    866:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   867:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   868:          ."'>".$linktext.'</a>'
1.787     bisitz    869:          .'</span>';
1.74      www       870: }
1.42      matthew   871: 
1.653     raeburn   872: sub selectauthor_link {
                    873:    my ($form,$udom)=@_;
                    874:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    875:           &mt('Select Author').'</a>';
                    876: }
                    877: 
1.876     raeburn   878: sub selectuser_link {
1.881     raeburn   879:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   880:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   881:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   882:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   883:            ');">'.$linktext.'</a>';
1.876     raeburn   884: }
                    885: 
1.273     raeburn   886: sub check_uncheck_jscript {
                    887:     my $jscript = <<"ENDSCRT";
                    888: function checkAll(field) {
                    889:     if (field.length > 0) {
                    890:         for (i = 0; i < field.length; i++) {
                    891:             field[i].checked = true ;
                    892:         }
                    893:     } else {
                    894:         field.checked = true
                    895:     }
                    896: }
                    897:  
                    898: function uncheckAll(field) {
                    899:     if (field.length > 0) {
                    900:         for (i = 0; i < field.length; i++) {
                    901:             field[i].checked = false ;
1.543     albertel  902:         }
                    903:     } else {
1.273     raeburn   904:         field.checked = false ;
                    905:     }
                    906: }
                    907: ENDSCRT
                    908:     return $jscript;
                    909: }
                    910: 
1.656     www       911: sub select_timezone {
1.659     raeburn   912:    my ($name,$selected,$onchange,$includeempty)=@_;
                    913:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    914:    if ($includeempty) {
                    915:        $output .= '<option value=""';
                    916:        if (($selected eq '') || ($selected eq 'local')) {
                    917:            $output .= ' selected="selected" ';
                    918:        }
                    919:        $output .= '> </option>';
                    920:    }
1.657     raeburn   921:    my @timezones = DateTime::TimeZone->all_names;
                    922:    foreach my $tzone (@timezones) {
                    923:        $output.= '<option value="'.$tzone.'"';
                    924:        if ($tzone eq $selected) {
                    925:            $output.=' selected="selected"';
                    926:        }
                    927:        $output.=">$tzone</option>\n";
1.656     www       928:    }
                    929:    $output.="</select>";
                    930:    return $output;
                    931: }
1.273     raeburn   932: 
1.687     raeburn   933: sub select_datelocale {
                    934:     my ($name,$selected,$onchange,$includeempty)=@_;
                    935:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    936:     if ($includeempty) {
                    937:         $output .= '<option value=""';
                    938:         if ($selected eq '') {
                    939:             $output .= ' selected="selected" ';
                    940:         }
                    941:         $output .= '> </option>';
                    942:     }
                    943:     my (@possibles,%locale_names);
                    944:     my @locales = DateTime::Locale::Catalog::Locales;
                    945:     foreach my $locale (@locales) {
                    946:         if (ref($locale) eq 'HASH') {
                    947:             my $id = $locale->{'id'};
                    948:             if ($id ne '') {
                    949:                 my $en_terr = $locale->{'en_territory'};
                    950:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   951:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   952:                 if (grep(/^en$/,@languages) || !@languages) {
                    953:                     if ($en_terr ne '') {
                    954:                         $locale_names{$id} = '('.$en_terr.')';
                    955:                     } elsif ($native_terr ne '') {
                    956:                         $locale_names{$id} = $native_terr;
                    957:                     }
                    958:                 } else {
                    959:                     if ($native_terr ne '') {
                    960:                         $locale_names{$id} = $native_terr.' ';
                    961:                     } elsif ($en_terr ne '') {
                    962:                         $locale_names{$id} = '('.$en_terr.')';
                    963:                     }
                    964:                 }
                    965:                 push (@possibles,$id);
                    966:             }
                    967:         }
                    968:     }
                    969:     foreach my $item (sort(@possibles)) {
                    970:         $output.= '<option value="'.$item.'"';
                    971:         if ($item eq $selected) {
                    972:             $output.=' selected="selected"';
                    973:         }
                    974:         $output.=">$item";
                    975:         if ($locale_names{$item} ne '') {
                    976:             $output.="  $locale_names{$item}</option>\n";
                    977:         }
                    978:         $output.="</option>\n";
                    979:     }
                    980:     $output.="</select>";
                    981:     return $output;
                    982: }
                    983: 
1.792     raeburn   984: sub select_language {
                    985:     my ($name,$selected,$includeempty) = @_;
                    986:     my %langchoices;
                    987:     if ($includeempty) {
                    988:         %langchoices = ('' => 'No language preference');
                    989:     }
                    990:     foreach my $id (&languageids()) {
                    991:         my $code = &supportedlanguagecode($id);
                    992:         if ($code) {
                    993:             $langchoices{$code} = &plainlanguagedescription($id);
                    994:         }
                    995:     }
1.970     raeburn   996:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn   997: }
                    998: 
1.42      matthew   999: =pod
1.36      matthew  1000: 
1.1088    foxr     1001: 
                   1002: =item * &list_languages()
                   1003: 
                   1004: Returns an array reference that is suitable for use in language prompters.
                   1005: Each array element is itself a two element array.  The first element
                   1006: is the language code.  The second element a descsriptiuon of the 
                   1007: language itself.  This is suitable for use in e.g.
                   1008: &Apache::edit::select_arg (once dereferenced that is).
                   1009: 
                   1010: =cut 
                   1011: 
                   1012: sub list_languages {
                   1013:     my @lang_choices;
                   1014: 
                   1015:     foreach my $id (&languageids()) {
                   1016: 	my $code = &supportedlanguagecode($id);
                   1017: 	if ($code) {
                   1018: 	    my $selector    = $supported_codes{$id};
                   1019: 	    my $description = &plainlanguagedescription($id);
                   1020: 	    push (@lang_choices, [$selector, $description]);
                   1021: 	}
                   1022:     }
                   1023:     return \@lang_choices;
                   1024: }
                   1025: 
                   1026: =pod
                   1027: 
1.648     raeburn  1028: =item * &linked_select_forms(...)
1.36      matthew  1029: 
                   1030: linked_select_forms returns a string containing a <script></script> block
                   1031: and html for two <select> menus.  The select menus will be linked in that
                   1032: changing the value of the first menu will result in new values being placed
                   1033: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1034: order unless a defined order is provided.
1.36      matthew  1035: 
                   1036: linked_select_forms takes the following ordered inputs:
                   1037: 
                   1038: =over 4
                   1039: 
1.112     bowersj2 1040: =item * $formname, the name of the <form> tag
1.36      matthew  1041: 
1.112     bowersj2 1042: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1043: 
1.112     bowersj2 1044: =item * $firstdefault, the default value for the first menu
1.36      matthew  1045: 
1.112     bowersj2 1046: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1047: 
1.112     bowersj2 1048: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1049: 
1.112     bowersj2 1050: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1051: 
1.609     raeburn  1052: =item * $menuorder, the order of values in the first menu
                   1053: 
1.41      ng       1054: =back 
                   1055: 
1.36      matthew  1056: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1057: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1058: values for the first select menu.  The text that coincides with the 
1.41      ng       1059: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1060: and text for the second menu are given in the hash pointed to by 
                   1061: $menu{$choice1}->{'select2'}.  
                   1062: 
1.112     bowersj2 1063:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1064:                        default => "B3",
                   1065:                        select2 => { 
                   1066:                            B1 => "Choice B1",
                   1067:                            B2 => "Choice B2",
                   1068:                            B3 => "Choice B3",
                   1069:                            B4 => "Choice B4"
1.609     raeburn  1070:                            },
                   1071:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1072:                    },
                   1073:                A2 => { text =>"Choice A2" ,
                   1074:                        default => "C2",
                   1075:                        select2 => { 
                   1076:                            C1 => "Choice C1",
                   1077:                            C2 => "Choice C2",
                   1078:                            C3 => "Choice C3"
1.609     raeburn  1079:                            },
                   1080:                        order => ['C2','C1','C3'],
1.112     bowersj2 1081:                    },
                   1082:                A3 => { text =>"Choice A3" ,
                   1083:                        default => "D6",
                   1084:                        select2 => { 
                   1085:                            D1 => "Choice D1",
                   1086:                            D2 => "Choice D2",
                   1087:                            D3 => "Choice D3",
                   1088:                            D4 => "Choice D4",
                   1089:                            D5 => "Choice D5",
                   1090:                            D6 => "Choice D6",
                   1091:                            D7 => "Choice D7"
1.609     raeburn  1092:                            },
                   1093:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1094:                    }
                   1095:                );
1.36      matthew  1096: 
                   1097: =cut
                   1098: 
                   1099: sub linked_select_forms {
                   1100:     my ($formname,
                   1101:         $middletext,
                   1102:         $firstdefault,
                   1103:         $firstselectname,
                   1104:         $secondselectname, 
1.609     raeburn  1105:         $hashref,
                   1106:         $menuorder,
1.36      matthew  1107:         ) = @_;
                   1108:     my $second = "document.$formname.$secondselectname";
                   1109:     my $first = "document.$formname.$firstselectname";
                   1110:     # output the javascript to do the changing
                   1111:     my $result = '';
1.776     bisitz   1112:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1113:     $result.="// <![CDATA[\n";
1.36      matthew  1114:     $result.="var select2data = new Object();\n";
                   1115:     $" = '","';
                   1116:     my $debug = '';
                   1117:     foreach my $s1 (sort(keys(%$hashref))) {
                   1118:         $result.="select2data.d_$s1 = new Object();\n";        
                   1119:         $result.="select2data.d_$s1.def = new String('".
                   1120:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1121:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1122:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1123:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1124:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1125:         }
1.36      matthew  1126:         $result.="\"@s2values\");\n";
                   1127:         $result.="select2data.d_$s1.texts = new Array(";        
                   1128:         my @s2texts;
                   1129:         foreach my $value (@s2values) {
                   1130:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1131:         }
                   1132:         $result.="\"@s2texts\");\n";
                   1133:     }
                   1134:     $"=' ';
                   1135:     $result.= <<"END";
                   1136: 
                   1137: function select1_changed() {
                   1138:     // Determine new choice
                   1139:     var newvalue = "d_" + $first.value;
                   1140:     // update select2
                   1141:     var values     = select2data[newvalue].values;
                   1142:     var texts      = select2data[newvalue].texts;
                   1143:     var select2def = select2data[newvalue].def;
                   1144:     var i;
                   1145:     // out with the old
                   1146:     for (i = 0; i < $second.options.length; i++) {
                   1147:         $second.options[i] = null;
                   1148:     }
                   1149:     // in with the nuclear
                   1150:     for (i=0;i<values.length; i++) {
                   1151:         $second.options[i] = new Option(values[i]);
1.143     matthew  1152:         $second.options[i].value = values[i];
1.36      matthew  1153:         $second.options[i].text = texts[i];
                   1154:         if (values[i] == select2def) {
                   1155:             $second.options[i].selected = true;
                   1156:         }
                   1157:     }
                   1158: }
1.824     bisitz   1159: // ]]>
1.36      matthew  1160: </script>
                   1161: END
                   1162:     # output the initial values for the selection lists
                   1163:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1164:     my @order = sort(keys(%{$hashref}));
                   1165:     if (ref($menuorder) eq 'ARRAY') {
                   1166:         @order = @{$menuorder};
                   1167:     }
                   1168:     foreach my $value (@order) {
1.36      matthew  1169:         $result.="    <option value=\"$value\" ";
1.253     albertel 1170:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1171:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1172:     }
                   1173:     $result .= "</select>\n";
                   1174:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1175:     $result .= $middletext;
                   1176:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1177:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1178:     
                   1179:     my @secondorder = sort(keys(%select2));
                   1180:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1181:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1182:     }
                   1183:     foreach my $value (@secondorder) {
1.36      matthew  1184:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1185:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1186:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1187:     }
                   1188:     $result .= "</select>\n";
                   1189:     #    return $debug;
                   1190:     return $result;
                   1191: }   #  end of sub linked_select_forms {
                   1192: 
1.45      matthew  1193: =pod
1.44      bowersj2 1194: 
1.973     raeburn  1195: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1196: 
1.112     bowersj2 1197: Returns a string corresponding to an HTML link to the given help
                   1198: $topic, where $topic corresponds to the name of a .tex file in
                   1199: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1200: spaces. 
                   1201: 
                   1202: $text will optionally be linked to the same topic, allowing you to
                   1203: link text in addition to the graphic. If you do not want to link
                   1204: text, but wish to specify one of the later parameters, pass an
                   1205: empty string. 
                   1206: 
                   1207: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1208: the link will not open a new window. If false, the link will open
                   1209: a new window using Javascript. (Default is false.) 
                   1210: 
                   1211: $width and $height are optional numerical parameters that will
                   1212: override the width and height of the popped up window, which may
1.973     raeburn  1213: be useful for certain help topics with big pictures included.
                   1214: 
                   1215: $imgid is the id of the img tag used for the help icon. This may be
                   1216: used in a javascript call to switch the image src.  See 
                   1217: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1218: 
                   1219: =cut
                   1220: 
                   1221: sub help_open_topic {
1.973     raeburn  1222:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1223:     $text = "" if (not defined $text);
1.44      bowersj2 1224:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1225:     $width = 500 if (not defined $width);
1.44      bowersj2 1226:     $height = 400 if (not defined $height);
                   1227:     my $filename = $topic;
                   1228:     $filename =~ s/ /_/g;
                   1229: 
1.48      bowersj2 1230:     my $template = "";
                   1231:     my $link;
1.572     banghart 1232:     
1.159     www      1233:     $topic=~s/\W/\_/g;
1.44      bowersj2 1234: 
1.572     banghart 1235:     if (!$stayOnPage) {
1.1033    www      1236: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1237:     } elsif ($stayOnPage eq 'popup') {
                   1238:         $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 1239:     } else {
1.48      bowersj2 1240: 	$link = "/adm/help/${filename}.hlp";
                   1241:     }
                   1242: 
                   1243:     # Add the text
1.755     neumanie 1244:     if ($text ne "") {	
1.763     bisitz   1245: 	$template.='<span class="LC_help_open_topic">'
                   1246:                   .'<a target="_top" href="'.$link.'">'
                   1247:                   .$text.'</a>';
1.48      bowersj2 1248:     }
                   1249: 
1.763     bisitz   1250:     # (Always) Add the graphic
1.179     matthew  1251:     my $title = &mt('Online Help');
1.667     raeburn  1252:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1253:     if ($imgid ne '') {
                   1254:         $imgid = ' id="'.$imgid.'"';
                   1255:     }
1.763     bisitz   1256:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1257:               .'<img src="'.$helpicon.'" border="0"'
                   1258:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1259:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1260:               .' /></a>';
                   1261:     if ($text ne "") {	
                   1262:         $template.='</span>';
                   1263:     }
1.44      bowersj2 1264:     return $template;
                   1265: 
1.106     bowersj2 1266: }
                   1267: 
                   1268: # This is a quicky function for Latex cheatsheet editing, since it 
                   1269: # appears in at least four places
                   1270: sub helpLatexCheatsheet {
1.1037    www      1271:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1272:     my $out;
1.106     bowersj2 1273:     my $addOther = '';
1.732     raeburn  1274:     if ($topic) {
1.1037    www      1275: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1276:     }
                   1277:     $out = '<span>' # Start cheatsheet
                   1278: 	  .$addOther
                   1279:           .'<span>'
1.1037    www      1280: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1281: 	  .'</span> <span>'
1.1037    www      1282: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1283: 	  .'</span>';
1.732     raeburn  1284:     unless ($not_author) {
1.763     bisitz   1285:         $out .= ' <span>'
1.1037    www      1286: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1287: 	       .'</span>';
1.732     raeburn  1288:     }
1.763     bisitz   1289:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1290:     return $out;
1.172     www      1291: }
                   1292: 
1.430     albertel 1293: sub general_help {
                   1294:     my $helptopic='Student_Intro';
                   1295:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1296: 	$helptopic='Authoring_Intro';
1.907     raeburn  1297:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1298: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1299:     } elsif ($env{'request.role'}=~/^dc/) {
                   1300:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1301:     }
                   1302:     return $helptopic;
                   1303: }
                   1304: 
                   1305: sub update_help_link {
                   1306:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1307:     my $origurl = $ENV{'REQUEST_URI'};
                   1308:     $origurl=~s|^/~|/priv/|;
                   1309:     my $timestamp = time;
                   1310:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1311:         $$datum = &escape($$datum);
                   1312:     }
                   1313: 
                   1314:     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";
                   1315:     my $output .= <<"ENDOUTPUT";
                   1316: <script type="text/javascript">
1.824     bisitz   1317: // <![CDATA[
1.430     albertel 1318: banner_link = '$banner_link';
1.824     bisitz   1319: // ]]>
1.430     albertel 1320: </script>
                   1321: ENDOUTPUT
                   1322:     return $output;
                   1323: }
                   1324: 
                   1325: # now just updates the help link and generates a blue icon
1.193     raeburn  1326: sub help_open_menu {
1.430     albertel 1327:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1328: 	= @_;    
1.949     droeschl 1329:     $stayOnPage = 1;
1.430     albertel 1330:     my $output;
                   1331:     if ($component_help) {
                   1332: 	if (!$text) {
                   1333: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1334: 				       $width,$height);
                   1335: 	} else {
                   1336: 	    my $help_text;
                   1337: 	    $help_text=&unescape($topic);
                   1338: 	    $output='<table><tr><td>'.
                   1339: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1340: 				 $width,$height).'</td></tr></table>';
                   1341: 	}
                   1342:     }
                   1343:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1344:     return $output.$banner_link;
                   1345: }
                   1346: 
                   1347: sub top_nav_help {
                   1348:     my ($text) = @_;
1.436     albertel 1349:     $text = &mt($text);
1.949     droeschl 1350:     my $stay_on_page = 1;
                   1351: 
1.572     banghart 1352:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1353: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1354:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1355: 
1.201     raeburn  1356:     my $title = &mt('Get help');
1.436     albertel 1357: 
                   1358:     return <<"END";
                   1359: $banner_link
                   1360:  <a href="$link" title="$title">$text</a>
                   1361: END
                   1362: }
                   1363: 
                   1364: sub help_menu_js {
                   1365:     my ($text) = @_;
1.949     droeschl 1366:     my $stayOnPage = 1;
1.436     albertel 1367:     my $width = 620;
                   1368:     my $height = 600;
1.430     albertel 1369:     my $helptopic=&general_help();
                   1370:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1371:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1372:     my $start_page =
                   1373:         &Apache::loncommon::start_page('Help Menu', undef,
                   1374: 				       {'frameset'    => 1,
                   1375: 					'js_ready'    => 1,
                   1376: 					'add_entries' => {
                   1377: 					    'border' => '0',
1.579     raeburn  1378: 					    'rows'   => "110,*",},});
1.331     albertel 1379:     my $end_page =
                   1380:         &Apache::loncommon::end_page({'frameset' => 1,
                   1381: 				      'js_ready' => 1,});
                   1382: 
1.436     albertel 1383:     my $template .= <<"ENDTEMPLATE";
                   1384: <script type="text/javascript">
1.877     bisitz   1385: // <![CDATA[
1.253     albertel 1386: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1387: var banner_link = '';
1.243     raeburn  1388: function helpMenu(target) {
                   1389:     var caller = this;
                   1390:     if (target == 'open') {
                   1391:         var newWindow = null;
                   1392:         try {
1.262     albertel 1393:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1394:         }
                   1395:         catch(error) {
                   1396:             writeHelp(caller);
                   1397:             return;
                   1398:         }
                   1399:         if (newWindow) {
                   1400:             caller = newWindow;
                   1401:         }
1.193     raeburn  1402:     }
1.243     raeburn  1403:     writeHelp(caller);
                   1404:     return;
                   1405: }
                   1406: function writeHelp(caller) {
1.1072    raeburn  1407:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page')
1.243     raeburn  1408:     caller.document.close()
                   1409:     caller.focus()
1.193     raeburn  1410: }
1.877     bisitz   1411: // END LON-CAPA Internal -->
1.253     albertel 1412: // ]]>
1.436     albertel 1413: </script>
1.193     raeburn  1414: ENDTEMPLATE
                   1415:     return $template;
                   1416: }
                   1417: 
1.172     www      1418: sub help_open_bug {
                   1419:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1420:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1421:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1422:     $text = "" if (not defined $text);
                   1423: 	$stayOnPage=1;
1.184     albertel 1424:     $width = 600 if (not defined $width);
                   1425:     $height = 600 if (not defined $height);
1.172     www      1426: 
                   1427:     $topic=~s/\W+/\+/g;
                   1428:     my $link='';
                   1429:     my $template='';
1.379     albertel 1430:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1431: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1432:     if (!$stayOnPage)
                   1433:     {
                   1434: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1435:     }
                   1436:     else
                   1437:     {
                   1438: 	$link = $url;
                   1439:     }
                   1440:     # Add the text
                   1441:     if ($text ne "")
                   1442:     {
                   1443: 	$template .= 
                   1444:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1445:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1446:     }
                   1447: 
                   1448:     # Add the graphic
1.179     matthew  1449:     my $title = &mt('Report a Bug');
1.215     albertel 1450:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1451:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1452:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1453: ENDTEMPLATE
                   1454:     if ($text ne '') { $template.='</td></tr></table>' };
                   1455:     return $template;
                   1456: 
                   1457: }
                   1458: 
                   1459: sub help_open_faq {
                   1460:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1461:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1462:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1463:     $text = "" if (not defined $text);
                   1464: 	$stayOnPage=1;
                   1465:     $width = 350 if (not defined $width);
                   1466:     $height = 400 if (not defined $height);
                   1467: 
                   1468:     $topic=~s/\W+/\+/g;
                   1469:     my $link='';
                   1470:     my $template='';
                   1471:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1472:     if (!$stayOnPage)
                   1473:     {
                   1474: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1475:     }
                   1476:     else
                   1477:     {
                   1478: 	$link = $url;
                   1479:     }
                   1480: 
                   1481:     # Add the text
                   1482:     if ($text ne "")
                   1483:     {
                   1484: 	$template .= 
1.173     www      1485:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1486:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1487:     }
                   1488: 
                   1489:     # Add the graphic
1.179     matthew  1490:     my $title = &mt('View the FAQ');
1.215     albertel 1491:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1492:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1493:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1494: ENDTEMPLATE
                   1495:     if ($text ne '') { $template.='</td></tr></table>' };
                   1496:     return $template;
                   1497: 
1.44      bowersj2 1498: }
1.37      matthew  1499: 
1.180     matthew  1500: ###############################################################
                   1501: ###############################################################
                   1502: 
1.45      matthew  1503: =pod
                   1504: 
1.648     raeburn  1505: =item * &change_content_javascript():
1.256     matthew  1506: 
                   1507: This and the next function allow you to create small sections of an
                   1508: otherwise static HTML page that you can update on the fly with
                   1509: Javascript, even in Netscape 4.
                   1510: 
                   1511: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1512: must be written to the HTML page once. It will prove the Javascript
                   1513: function "change(name, content)". Calling the change function with the
                   1514: name of the section 
                   1515: you want to update, matching the name passed to C<changable_area>, and
                   1516: the new content you want to put in there, will put the content into
                   1517: that area.
                   1518: 
                   1519: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1520: to contain room for the original contents. You need to "make space"
                   1521: for whatever changes you wish to make, and be B<sure> to check your
                   1522: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1523: it's adequate for updating a one-line status display, but little more.
                   1524: This script will set the space to 100% width, so you only need to
                   1525: worry about height in Netscape 4.
                   1526: 
                   1527: Modern browsers are much less limiting, and if you can commit to the
                   1528: user not using Netscape 4, this feature may be used freely with
                   1529: pretty much any HTML.
                   1530: 
                   1531: =cut
                   1532: 
                   1533: sub change_content_javascript {
                   1534:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1535:     if ($env{'browser.type'} eq 'netscape' &&
                   1536: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1537: 	return (<<NETSCAPE4);
                   1538: 	function change(name, content) {
                   1539: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1540: 	    doc.open();
                   1541: 	    doc.write(content);
                   1542: 	    doc.close();
                   1543: 	}
                   1544: NETSCAPE4
                   1545:     } else {
                   1546: 	# Otherwise, we need to use semi-standards-compliant code
                   1547: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1548: 	# is really scary, and every useful browser supports it
                   1549: 	return (<<DOMBASED);
                   1550: 	function change(name, content) {
                   1551: 	    element = document.getElementById(name);
                   1552: 	    element.innerHTML = content;
                   1553: 	}
                   1554: DOMBASED
                   1555:     }
                   1556: }
                   1557: 
                   1558: =pod
                   1559: 
1.648     raeburn  1560: =item * &changable_area($name,$origContent):
1.256     matthew  1561: 
                   1562: This provides a "changable area" that can be modified on the fly via
                   1563: the Javascript code provided in C<change_content_javascript>. $name is
                   1564: the name you will use to reference the area later; do not repeat the
                   1565: same name on a given HTML page more then once. $origContent is what
                   1566: the area will originally contain, which can be left blank.
                   1567: 
                   1568: =cut
                   1569: 
                   1570: sub changable_area {
                   1571:     my ($name, $origContent) = @_;
                   1572: 
1.258     albertel 1573:     if ($env{'browser.type'} eq 'netscape' &&
                   1574: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1575: 	# If this is netscape 4, we need to use the Layer tag
                   1576: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1577:     } else {
                   1578: 	return "<span id='$name'>$origContent</span>";
                   1579:     }
                   1580: }
                   1581: 
                   1582: =pod
                   1583: 
1.648     raeburn  1584: =item * &viewport_geometry_js 
1.590     raeburn  1585: 
                   1586: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1587: 
                   1588: =cut
                   1589: 
                   1590: 
                   1591: sub viewport_geometry_js { 
                   1592:     return <<"GEOMETRY";
                   1593: var Geometry = {};
                   1594: function init_geometry() {
                   1595:     if (Geometry.init) { return };
                   1596:     Geometry.init=1;
                   1597:     if (window.innerHeight) {
                   1598:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1599:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1600:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1601:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1602:     }
                   1603:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1604:         Geometry.getViewportHeight =
                   1605:             function() { return document.documentElement.clientHeight; };
                   1606:         Geometry.getViewportWidth =
                   1607:             function() { return document.documentElement.clientWidth; };
                   1608: 
                   1609:         Geometry.getHorizontalScroll =
                   1610:             function() { return document.documentElement.scrollLeft; };
                   1611:         Geometry.getVerticalScroll =
                   1612:             function() { return document.documentElement.scrollTop; };
                   1613:     }
                   1614:     else if (document.body.clientHeight) {
                   1615:         Geometry.getViewportHeight =
                   1616:             function() { return document.body.clientHeight; };
                   1617:         Geometry.getViewportWidth =
                   1618:             function() { return document.body.clientWidth; };
                   1619:         Geometry.getHorizontalScroll =
                   1620:             function() { return document.body.scrollLeft; };
                   1621:         Geometry.getVerticalScroll =
                   1622:             function() { return document.body.scrollTop; };
                   1623:     }
                   1624: }
                   1625: 
                   1626: GEOMETRY
                   1627: }
                   1628: 
                   1629: =pod
                   1630: 
1.648     raeburn  1631: =item * &viewport_size_js()
1.590     raeburn  1632: 
                   1633: 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. 
                   1634: 
                   1635: =cut
                   1636: 
                   1637: sub viewport_size_js {
                   1638:     my $geometry = &viewport_geometry_js();
                   1639:     return <<"DIMS";
                   1640: 
                   1641: $geometry
                   1642: 
                   1643: function getViewportDims(width,height) {
                   1644:     init_geometry();
                   1645:     width.value = Geometry.getViewportWidth();
                   1646:     height.value = Geometry.getViewportHeight();
                   1647:     return;
                   1648: }
                   1649: 
                   1650: DIMS
                   1651: }
                   1652: 
                   1653: =pod
                   1654: 
1.648     raeburn  1655: =item * &resize_textarea_js()
1.565     albertel 1656: 
                   1657: emits the needed javascript to resize a textarea to be as big as possible
                   1658: 
                   1659: creates a function resize_textrea that takes two IDs first should be
                   1660: the id of the element to resize, second should be the id of a div that
                   1661: surrounds everything that comes after the textarea, this routine needs
                   1662: to be attached to the <body> for the onload and onresize events.
                   1663: 
1.648     raeburn  1664: =back
1.565     albertel 1665: 
                   1666: =cut
                   1667: 
                   1668: sub resize_textarea_js {
1.590     raeburn  1669:     my $geometry = &viewport_geometry_js();
1.565     albertel 1670:     return <<"RESIZE";
                   1671:     <script type="text/javascript">
1.824     bisitz   1672: // <![CDATA[
1.590     raeburn  1673: $geometry
1.565     albertel 1674: 
1.588     albertel 1675: function getX(element) {
                   1676:     var x = 0;
                   1677:     while (element) {
                   1678: 	x += element.offsetLeft;
                   1679: 	element = element.offsetParent;
                   1680:     }
                   1681:     return x;
                   1682: }
                   1683: function getY(element) {
                   1684:     var y = 0;
                   1685:     while (element) {
                   1686: 	y += element.offsetTop;
                   1687: 	element = element.offsetParent;
                   1688:     }
                   1689:     return y;
                   1690: }
                   1691: 
                   1692: 
1.565     albertel 1693: function resize_textarea(textarea_id,bottom_id) {
                   1694:     init_geometry();
                   1695:     var textarea        = document.getElementById(textarea_id);
                   1696:     //alert(textarea);
                   1697: 
1.588     albertel 1698:     var textarea_top    = getY(textarea);
1.565     albertel 1699:     var textarea_height = textarea.offsetHeight;
                   1700:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1701:     var bottom_top      = getY(bottom);
1.565     albertel 1702:     var bottom_height   = bottom.offsetHeight;
                   1703:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1704:     var fudge           = 23;
1.565     albertel 1705:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1706:     if (new_height < 300) {
                   1707: 	new_height = 300;
                   1708:     }
                   1709:     textarea.style.height=new_height+'px';
                   1710: }
1.824     bisitz   1711: // ]]>
1.565     albertel 1712: </script>
                   1713: RESIZE
                   1714: 
                   1715: }
                   1716: 
                   1717: =pod
                   1718: 
1.256     matthew  1719: =head1 Excel and CSV file utility routines
                   1720: 
                   1721: =over 4
                   1722: 
                   1723: =cut
                   1724: 
                   1725: ###############################################################
                   1726: ###############################################################
                   1727: 
                   1728: =pod
                   1729: 
1.648     raeburn  1730: =item * &csv_translate($text) 
1.37      matthew  1731: 
1.185     www      1732: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1733: format.
                   1734: 
                   1735: =cut
                   1736: 
1.180     matthew  1737: ###############################################################
                   1738: ###############################################################
1.37      matthew  1739: sub csv_translate {
                   1740:     my $text = shift;
                   1741:     $text =~ s/\"/\"\"/g;
1.209     albertel 1742:     $text =~ s/\n/ /g;
1.37      matthew  1743:     return $text;
                   1744: }
1.180     matthew  1745: 
                   1746: ###############################################################
                   1747: ###############################################################
                   1748: 
                   1749: =pod
                   1750: 
1.648     raeburn  1751: =item * &define_excel_formats()
1.180     matthew  1752: 
                   1753: Define some commonly used Excel cell formats.
                   1754: 
                   1755: Currently supported formats:
                   1756: 
                   1757: =over 4
                   1758: 
                   1759: =item header
                   1760: 
                   1761: =item bold
                   1762: 
                   1763: =item h1
                   1764: 
                   1765: =item h2
                   1766: 
                   1767: =item h3
                   1768: 
1.256     matthew  1769: =item h4
                   1770: 
                   1771: =item i
                   1772: 
1.180     matthew  1773: =item date
                   1774: 
                   1775: =back
                   1776: 
                   1777: Inputs: $workbook
                   1778: 
                   1779: Returns: $format, a hash reference.
                   1780: 
1.1057    foxr     1781: 
1.180     matthew  1782: =cut
                   1783: 
                   1784: ###############################################################
                   1785: ###############################################################
                   1786: sub define_excel_formats {
                   1787:     my ($workbook) = @_;
                   1788:     my $format;
                   1789:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1790:                                                 bottom    => 1,
                   1791:                                                 align     => 'center');
                   1792:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1793:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1794:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1795:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1796:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1797:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1798:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1799:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1800:     return $format;
                   1801: }
                   1802: 
                   1803: ###############################################################
                   1804: ###############################################################
1.113     bowersj2 1805: 
                   1806: =pod
                   1807: 
1.648     raeburn  1808: =item * &create_workbook()
1.255     matthew  1809: 
                   1810: Create an Excel worksheet.  If it fails, output message on the
                   1811: request object and return undefs.
                   1812: 
                   1813: Inputs: Apache request object
                   1814: 
                   1815: Returns (undef) on failure, 
                   1816:     Excel worksheet object, scalar with filename, and formats 
                   1817:     from &Apache::loncommon::define_excel_formats on success
                   1818: 
                   1819: =cut
                   1820: 
                   1821: ###############################################################
                   1822: ###############################################################
                   1823: sub create_workbook {
                   1824:     my ($r) = @_;
                   1825:         #
                   1826:     # Create the excel spreadsheet
                   1827:     my $filename = '/prtspool/'.
1.258     albertel 1828:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1829:         time.'_'.rand(1000000000).'.xls';
                   1830:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1831:     if (! defined($workbook)) {
                   1832:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1833:         $r->print(
                   1834:             '<p class="LC_error">'
                   1835:            .&mt('Problems occurred in creating the new Excel file.')
                   1836:            .' '.&mt('This error has been logged.')
                   1837:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1838:            .'</p>'
                   1839:         );
1.255     matthew  1840:         return (undef);
                   1841:     }
                   1842:     #
1.1014    foxr     1843:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1844:     #
                   1845:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1846:     return ($workbook,$filename,$format);
                   1847: }
                   1848: 
                   1849: ###############################################################
                   1850: ###############################################################
                   1851: 
                   1852: =pod
                   1853: 
1.648     raeburn  1854: =item * &create_text_file()
1.113     bowersj2 1855: 
1.542     raeburn  1856: Create a file to write to and eventually make available to the user.
1.256     matthew  1857: If file creation fails, outputs an error message on the request object and 
                   1858: return undefs.
1.113     bowersj2 1859: 
1.256     matthew  1860: Inputs: Apache request object, and file suffix
1.113     bowersj2 1861: 
1.256     matthew  1862: Returns (undef) on failure, 
                   1863:     Filehandle and filename on success.
1.113     bowersj2 1864: 
                   1865: =cut
                   1866: 
1.256     matthew  1867: ###############################################################
                   1868: ###############################################################
                   1869: sub create_text_file {
                   1870:     my ($r,$suffix) = @_;
                   1871:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1872:     my $fh;
                   1873:     my $filename = '/prtspool/'.
1.258     albertel 1874:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1875:         time.'_'.rand(1000000000).'.'.$suffix;
                   1876:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1877:     if (! defined($fh)) {
                   1878:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1879:         $r->print(
                   1880:             '<p class="LC_error">'
                   1881:            .&mt('Problems occurred in creating the output file.')
                   1882:            .' '.&mt('This error has been logged.')
                   1883:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1884:            .'</p>'
                   1885:         );
1.113     bowersj2 1886:     }
1.256     matthew  1887:     return ($fh,$filename)
1.113     bowersj2 1888: }
                   1889: 
                   1890: 
1.256     matthew  1891: =pod 
1.113     bowersj2 1892: 
                   1893: =back
                   1894: 
                   1895: =cut
1.37      matthew  1896: 
                   1897: ###############################################################
1.33      matthew  1898: ##        Home server <option> list generating code          ##
                   1899: ###############################################################
1.35      matthew  1900: 
1.169     www      1901: # ------------------------------------------
                   1902: 
                   1903: sub domain_select {
                   1904:     my ($name,$value,$multiple)=@_;
                   1905:     my %domains=map { 
1.514     albertel 1906: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1907:     } &Apache::lonnet::all_domains();
1.169     www      1908:     if ($multiple) {
                   1909: 	$domains{''}=&mt('Any domain');
1.550     albertel 1910: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1911: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1912:     } else {
1.550     albertel 1913: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1914: 	return &select_form($name,$value,\%domains);
1.169     www      1915:     }
                   1916: }
                   1917: 
1.282     albertel 1918: #-------------------------------------------
                   1919: 
                   1920: =pod
                   1921: 
1.519     raeburn  1922: =head1 Routines for form select boxes
                   1923: 
                   1924: =over 4
                   1925: 
1.648     raeburn  1926: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1927: 
                   1928: Returns a string containing a <select> element int multiple mode
                   1929: 
                   1930: 
                   1931: Args:
                   1932:   $name - name of the <select> element
1.506     raeburn  1933:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1934:   $size - number of rows long the select element is
1.283     albertel 1935:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1936:           (shown text should already have been &mt())
1.506     raeburn  1937:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1938: 
1.282     albertel 1939: =cut
                   1940: 
                   1941: #-------------------------------------------
1.169     www      1942: sub multiple_select_form {
1.284     albertel 1943:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1944:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1945:     my $output='';
1.191     matthew  1946:     if (! defined($size)) {
                   1947:         $size = 4;
1.283     albertel 1948:         if (scalar(keys(%$hash))<4) {
                   1949:             $size = scalar(keys(%$hash));
1.191     matthew  1950:         }
                   1951:     }
1.734     bisitz   1952:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1953:     my @order;
1.506     raeburn  1954:     if (ref($order) eq 'ARRAY')  {
                   1955:         @order = @{$order};
                   1956:     } else {
                   1957:         @order = sort(keys(%$hash));
1.501     banghart 1958:     }
                   1959:     if (exists($$hash{'select_form_order'})) {
                   1960:         @order = @{$$hash{'select_form_order'}};
                   1961:     }
                   1962:         
1.284     albertel 1963:     foreach my $key (@order) {
1.356     albertel 1964:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1965:         $output.='selected="selected" ' if ($selected{$key});
                   1966:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1967:     }
                   1968:     $output.="</select>\n";
                   1969:     return $output;
                   1970: }
                   1971: 
1.88      www      1972: #-------------------------------------------
                   1973: 
                   1974: =pod
                   1975: 
1.970     raeburn  1976: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1977: 
                   1978: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1979: allow a user to select options from a ref to a hash containing:
                   1980: option_name => displayed text. An optional $onchange can include
                   1981: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1982: 
1.88      www      1983: See lonrights.pm for an example invocation and use.
                   1984: 
                   1985: =cut
                   1986: 
                   1987: #-------------------------------------------
                   1988: sub select_form {
1.970     raeburn  1989:     my ($def,$name,$hashref,$onchange) = @_;
                   1990:     return unless (ref($hashref) eq 'HASH');
                   1991:     if ($onchange) {
                   1992:         $onchange = ' onchange="'.$onchange.'"';
                   1993:     }
                   1994:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1995:     my @keys;
1.970     raeburn  1996:     if (exists($hashref->{'select_form_order'})) {
                   1997: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1998:     } else {
1.970     raeburn  1999: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2000:     }
1.356     albertel 2001:     foreach my $key (@keys) {
                   2002:         $selectform.=
                   2003: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2004:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2005:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2006:     }
                   2007:     $selectform.="</select>";
                   2008:     return $selectform;
                   2009: }
                   2010: 
1.475     www      2011: # For display filters
                   2012: 
                   2013: sub display_filter {
1.1074    raeburn  2014:     my ($context) = @_;
1.475     www      2015:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2016:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2017:     my $phraseinput = 'hidden';
                   2018:     my $includeinput = 'hidden';
                   2019:     my ($checked,$includetypestext);
                   2020:     if ($env{'form.displayfilter'} eq 'containing') {
                   2021:         $phraseinput = 'text'; 
                   2022:         if ($context eq 'parmslog') {
                   2023:             $includeinput = 'checkbox';
                   2024:             if ($env{'form.includetypes'}) {
                   2025:                 $checked = ' checked="checked"';
                   2026:             }
                   2027:             $includetypestext = &mt('Include parameter types');
                   2028:         }
                   2029:     } else {
                   2030:         $includetypestext = '&nbsp;';
                   2031:     }
                   2032:     my ($additional,$secondid,$thirdid);
                   2033:     if ($context eq 'parmslog') {
                   2034:         $additional = 
                   2035:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2036:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2037:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2038:             '</label>';
                   2039:         $secondid = 'includetypes';
                   2040:         $thirdid = 'includetypestext';
                   2041:     }
                   2042:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2043:                                                     '$secondid','$thirdid')";
                   2044:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2045: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2046: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2047: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2048:            &mt('Filter: [_1]',
1.477     www      2049: 	   &select_form($env{'form.displayfilter'},
                   2050: 			'displayfilter',
1.970     raeburn  2051: 			{'currentfolder' => 'Current folder/page',
1.477     www      2052: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2053: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2054: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2055:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2056:                          '" />'.$additional;
                   2057: }
                   2058: 
                   2059: sub display_filter_js {
                   2060:     my $includetext = &mt('Include parameter types');
                   2061:     return <<"ENDJS";
                   2062:   
                   2063: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2064:     var firstType = 'hidden';
                   2065:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2066:         firstType = 'text';
                   2067:     }
                   2068:     firstObject = document.getElementById(firstid);
                   2069:     if (typeof(firstObject) == 'object') {
                   2070:         if (firstObject.type != firstType) {
                   2071:             changeInputType(firstObject,firstType);
                   2072:         }
                   2073:     }
                   2074:     if (context == 'parmslog') {
                   2075:         var secondType = 'hidden';
                   2076:         if (firstType == 'text') {
                   2077:             secondType = 'checkbox';
                   2078:         }
                   2079:         secondObject = document.getElementById(secondid);  
                   2080:         if (typeof(secondObject) == 'object') {
                   2081:             if (secondObject.type != secondType) {
                   2082:                 changeInputType(secondObject,secondType);
                   2083:             }
                   2084:         }
                   2085:         var textItem = document.getElementById(thirdid);
                   2086:         var currtext = textItem.innerHTML;
                   2087:         var newtext;
                   2088:         if (firstType == 'text') {
                   2089:             newtext = '$includetext';
                   2090:         } else {
                   2091:             newtext = '&nbsp;';
                   2092:         }
                   2093:         if (currtext != newtext) {
                   2094:             textItem.innerHTML = newtext;
                   2095:         }
                   2096:     }
                   2097:     return;
                   2098: }
                   2099: 
                   2100: function changeInputType(oldObject,newType) {
                   2101:     var newObject = document.createElement('input');
                   2102:     newObject.type = newType;
                   2103:     if (oldObject.size) {
                   2104:         newObject.size = oldObject.size;
                   2105:     }
                   2106:     if (oldObject.value) {
                   2107:         newObject.value = oldObject.value;
                   2108:     }
                   2109:     if (oldObject.name) {
                   2110:         newObject.name = oldObject.name;
                   2111:     }
                   2112:     if (oldObject.id) {
                   2113:         newObject.id = oldObject.id;
                   2114:     }
                   2115:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2116:     return;
                   2117: }
                   2118: 
                   2119: ENDJS
1.475     www      2120: }
                   2121: 
1.167     www      2122: sub gradeleveldescription {
                   2123:     my $gradelevel=shift;
                   2124:     my %gradelevels=(0 => 'Not specified',
                   2125: 		     1 => 'Grade 1',
                   2126: 		     2 => 'Grade 2',
                   2127: 		     3 => 'Grade 3',
                   2128: 		     4 => 'Grade 4',
                   2129: 		     5 => 'Grade 5',
                   2130: 		     6 => 'Grade 6',
                   2131: 		     7 => 'Grade 7',
                   2132: 		     8 => 'Grade 8',
                   2133: 		     9 => 'Grade 9',
                   2134: 		     10 => 'Grade 10',
                   2135: 		     11 => 'Grade 11',
                   2136: 		     12 => 'Grade 12',
                   2137: 		     13 => 'Grade 13',
                   2138: 		     14 => '100 Level',
                   2139: 		     15 => '200 Level',
                   2140: 		     16 => '300 Level',
                   2141: 		     17 => '400 Level',
                   2142: 		     18 => 'Graduate Level');
                   2143:     return &mt($gradelevels{$gradelevel});
                   2144: }
                   2145: 
1.163     www      2146: sub select_level_form {
                   2147:     my ($deflevel,$name)=@_;
                   2148:     unless ($deflevel) { $deflevel=0; }
1.167     www      2149:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2150:     for (my $i=0; $i<=18; $i++) {
                   2151:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2152:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2153:                 ">".&gradeleveldescription($i)."</option>\n";
                   2154:     }
                   2155:     $selectform.="</select>";
                   2156:     return $selectform;
1.163     www      2157: }
1.167     www      2158: 
1.35      matthew  2159: #-------------------------------------------
                   2160: 
1.45      matthew  2161: =pod
                   2162: 
1.910     raeburn  2163: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  2164: 
                   2165: Returns a string containing a <select name='$name' size='1'> form to 
                   2166: allow a user to select the domain to preform an operation in.  
                   2167: See loncreateuser.pm for an example invocation and use.
                   2168: 
1.90      www      2169: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2170: selected");
                   2171: 
1.743     raeburn  2172: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2173: 
1.910     raeburn  2174: 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.
                   2175: 
                   2176: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  2177: 
1.35      matthew  2178: =cut
                   2179: 
                   2180: #-------------------------------------------
1.34      matthew  2181: sub select_dom_form {
1.910     raeburn  2182:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  2183:     if ($onchange) {
1.874     raeburn  2184:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2185:     }
1.910     raeburn  2186:     my @domains;
                   2187:     if (ref($incdoms) eq 'ARRAY') {
                   2188:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2189:     } else {
                   2190:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2191:     }
1.90      www      2192:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  2193:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2194:     foreach my $dom (@domains) {
                   2195:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2196:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2197:         if ($showdomdesc) {
                   2198:             if ($dom ne '') {
                   2199:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2200:                 if ($domdesc ne '') {
                   2201:                     $selectdomain .= ' ('.$domdesc.')';
                   2202:                 }
                   2203:             } 
                   2204:         }
                   2205:         $selectdomain .= "</option>\n";
1.34      matthew  2206:     }
                   2207:     $selectdomain.="</select>";
                   2208:     return $selectdomain;
                   2209: }
                   2210: 
1.35      matthew  2211: #-------------------------------------------
                   2212: 
1.45      matthew  2213: =pod
                   2214: 
1.648     raeburn  2215: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2216: 
1.586     raeburn  2217: input: 4 arguments (two required, two optional) - 
                   2218:     $domain - domain of new user
                   2219:     $name - name of form element
                   2220:     $default - Value of 'default' causes a default item to be first 
                   2221:                             option, and selected by default. 
                   2222:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2223:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2224: output: returns 2 items: 
1.586     raeburn  2225: (a) form element which contains either:
                   2226:    (i) <select name="$name">
                   2227:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2228:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2229:        </select>
                   2230:        form item if there are multiple library servers in $domain, or
                   2231:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2232:        if there is only one library server in $domain.
                   2233: 
                   2234: (b) number of library servers found.
                   2235: 
                   2236: See loncreateuser.pm for example of use.
1.35      matthew  2237: 
                   2238: =cut
                   2239: 
                   2240: #-------------------------------------------
1.586     raeburn  2241: sub home_server_form_item {
                   2242:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2243:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2244:     my $result;
                   2245:     my $numlib = keys(%servers);
                   2246:     if ($numlib > 1) {
                   2247:         $result .= '<select name="'.$name.'" />'."\n";
                   2248:         if ($default) {
1.804     bisitz   2249:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2250:                        '</option>'."\n";
                   2251:         }
                   2252:         foreach my $hostid (sort(keys(%servers))) {
                   2253:             $result.= '<option value="'.$hostid.'">'.
                   2254: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2255:         }
                   2256:         $result .= '</select>'."\n";
                   2257:     } elsif ($numlib == 1) {
                   2258:         my $hostid;
                   2259:         foreach my $item (keys(%servers)) {
                   2260:             $hostid = $item;
                   2261:         }
                   2262:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2263:                    $hostid.'" />';
                   2264:                    if (!$hide) {
                   2265:                        $result .= $hostid.' '.$servers{$hostid};
                   2266:                    }
                   2267:                    $result .= "\n";
                   2268:     } elsif ($default) {
                   2269:         $result .= '<input type="hidden" name="'.$name.
                   2270:                    '" value="default" />';
                   2271:                    if (!$hide) {
                   2272:                        $result .= &mt('default');
                   2273:                    }
                   2274:                    $result .= "\n";
1.33      matthew  2275:     }
1.586     raeburn  2276:     return ($result,$numlib);
1.33      matthew  2277: }
1.112     bowersj2 2278: 
                   2279: =pod
                   2280: 
1.534     albertel 2281: =back 
                   2282: 
1.112     bowersj2 2283: =cut
1.87      matthew  2284: 
                   2285: ###############################################################
1.112     bowersj2 2286: ##                  Decoding User Agent                      ##
1.87      matthew  2287: ###############################################################
                   2288: 
                   2289: =pod
                   2290: 
1.112     bowersj2 2291: =head1 Decoding the User Agent
                   2292: 
                   2293: =over 4
                   2294: 
                   2295: =item * &decode_user_agent()
1.87      matthew  2296: 
                   2297: Inputs: $r
                   2298: 
                   2299: Outputs:
                   2300: 
                   2301: =over 4
                   2302: 
1.112     bowersj2 2303: =item * $httpbrowser
1.87      matthew  2304: 
1.112     bowersj2 2305: =item * $clientbrowser
1.87      matthew  2306: 
1.112     bowersj2 2307: =item * $clientversion
1.87      matthew  2308: 
1.112     bowersj2 2309: =item * $clientmathml
1.87      matthew  2310: 
1.112     bowersj2 2311: =item * $clientunicode
1.87      matthew  2312: 
1.112     bowersj2 2313: =item * $clientos
1.87      matthew  2314: 
                   2315: =back
                   2316: 
1.157     matthew  2317: =back 
                   2318: 
1.87      matthew  2319: =cut
                   2320: 
                   2321: ###############################################################
                   2322: ###############################################################
                   2323: sub decode_user_agent {
1.247     albertel 2324:     my ($r)=@_;
1.87      matthew  2325:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2326:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2327:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2328:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2329:     my $clientbrowser='unknown';
                   2330:     my $clientversion='0';
                   2331:     my $clientmathml='';
                   2332:     my $clientunicode='0';
                   2333:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2334:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2335: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2336: 	    $clientbrowser=$bname;
                   2337:             $httpbrowser=~/$vreg/i;
                   2338: 	    $clientversion=$1;
                   2339:             $clientmathml=($clientversion>=$minv);
                   2340:             $clientunicode=($clientversion>=$univ);
                   2341: 	}
                   2342:     }
                   2343:     my $clientos='unknown';
                   2344:     if (($httpbrowser=~/linux/i) ||
                   2345:         ($httpbrowser=~/unix/i) ||
                   2346:         ($httpbrowser=~/ux/i) ||
                   2347:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2348:     if (($httpbrowser=~/vax/i) ||
                   2349:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2350:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2351:     if (($httpbrowser=~/mac/i) ||
                   2352:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2353:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2354:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2355:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2356:             $clientunicode,$clientos,);
                   2357: }
                   2358: 
1.32      matthew  2359: ###############################################################
                   2360: ##    Authentication changing form generation subroutines    ##
                   2361: ###############################################################
                   2362: ##
                   2363: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2364: ## hash, and have reasonable default values.
                   2365: ##
                   2366: ##    formname = the name given in the <form> tag.
1.35      matthew  2367: #-------------------------------------------
                   2368: 
1.45      matthew  2369: =pod
                   2370: 
1.112     bowersj2 2371: =head1 Authentication Routines
                   2372: 
                   2373: =over 4
                   2374: 
1.648     raeburn  2375: =item * &authform_xxxxxx()
1.35      matthew  2376: 
                   2377: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2378: handle some of the conveniences required for authentication forms.  
                   2379: This is not an optimal method, but it works.  
                   2380: 
                   2381: =over 4
                   2382: 
1.112     bowersj2 2383: =item * authform_header
1.35      matthew  2384: 
1.112     bowersj2 2385: =item * authform_authorwarning
1.35      matthew  2386: 
1.112     bowersj2 2387: =item * authform_nochange
1.35      matthew  2388: 
1.112     bowersj2 2389: =item * authform_kerberos
1.35      matthew  2390: 
1.112     bowersj2 2391: =item * authform_internal
1.35      matthew  2392: 
1.112     bowersj2 2393: =item * authform_filesystem
1.35      matthew  2394: 
                   2395: =back
                   2396: 
1.648     raeburn  2397: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2398: 
1.35      matthew  2399: =cut
                   2400: 
                   2401: #-------------------------------------------
1.32      matthew  2402: sub authform_header{  
                   2403:     my %in = (
                   2404:         formname => 'cu',
1.80      albertel 2405:         kerb_def_dom => '',
1.32      matthew  2406:         @_,
                   2407:     );
                   2408:     $in{'formname'} = 'document.' . $in{'formname'};
                   2409:     my $result='';
1.80      albertel 2410: 
                   2411: #---------------------------------------------- Code for upper case translation
                   2412:     my $Javascript_toUpperCase;
                   2413:     unless ($in{kerb_def_dom}) {
                   2414:         $Javascript_toUpperCase =<<"END";
                   2415:         switch (choice) {
                   2416:            case 'krb': currentform.elements[choicearg].value =
                   2417:                currentform.elements[choicearg].value.toUpperCase();
                   2418:                break;
                   2419:            default:
                   2420:         }
                   2421: END
                   2422:     } else {
                   2423:         $Javascript_toUpperCase = "";
                   2424:     }
                   2425: 
1.165     raeburn  2426:     my $radioval = "'nochange'";
1.591     raeburn  2427:     if (defined($in{'curr_authtype'})) {
                   2428:         if ($in{'curr_authtype'} ne '') {
                   2429:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2430:         }
1.174     matthew  2431:     }
1.165     raeburn  2432:     my $argfield = 'null';
1.591     raeburn  2433:     if (defined($in{'mode'})) {
1.165     raeburn  2434:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2435:             if (defined($in{'curr_autharg'})) {
                   2436:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2437:                     $argfield = "'$in{'curr_autharg'}'";
                   2438:                 }
                   2439:             }
                   2440:         }
                   2441:     }
                   2442: 
1.32      matthew  2443:     $result.=<<"END";
                   2444: var current = new Object();
1.165     raeburn  2445: current.radiovalue = $radioval;
                   2446: current.argfield = $argfield;
1.32      matthew  2447: 
                   2448: function changed_radio(choice,currentform) {
                   2449:     var choicearg = choice + 'arg';
                   2450:     // If a radio button in changed, we need to change the argfield
                   2451:     if (current.radiovalue != choice) {
                   2452:         current.radiovalue = choice;
                   2453:         if (current.argfield != null) {
                   2454:             currentform.elements[current.argfield].value = '';
                   2455:         }
                   2456:         if (choice == 'nochange') {
                   2457:             current.argfield = null;
                   2458:         } else {
                   2459:             current.argfield = choicearg;
                   2460:             switch(choice) {
                   2461:                 case 'krb': 
                   2462:                     currentform.elements[current.argfield].value = 
                   2463:                         "$in{'kerb_def_dom'}";
                   2464:                 break;
                   2465:               default:
                   2466:                 break;
                   2467:             }
                   2468:         }
                   2469:     }
                   2470:     return;
                   2471: }
1.22      www      2472: 
1.32      matthew  2473: function changed_text(choice,currentform) {
                   2474:     var choicearg = choice + 'arg';
                   2475:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2476:         $Javascript_toUpperCase
1.32      matthew  2477:         // clear old field
                   2478:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2479:             currentform.elements[current.argfield].value = '';
                   2480:         }
                   2481:         current.argfield = choicearg;
                   2482:     }
                   2483:     set_auth_radio_buttons(choice,currentform);
                   2484:     return;
1.20      www      2485: }
1.32      matthew  2486: 
                   2487: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2488:     var numauthchoices = currentform.login.length;
                   2489:     if (typeof numauthchoices  == "undefined") {
                   2490:         return;
                   2491:     } 
1.32      matthew  2492:     var i=0;
1.986     raeburn  2493:     while (i < numauthchoices) {
1.32      matthew  2494:         if (currentform.login[i].value == newvalue) { break; }
                   2495:         i++;
                   2496:     }
1.986     raeburn  2497:     if (i == numauthchoices) {
1.32      matthew  2498:         return;
                   2499:     }
                   2500:     current.radiovalue = newvalue;
                   2501:     currentform.login[i].checked = true;
                   2502:     return;
                   2503: }
                   2504: END
                   2505:     return $result;
                   2506: }
                   2507: 
                   2508: sub authform_authorwarning{
                   2509:     my $result='';
1.144     matthew  2510:     $result='<i>'.
                   2511:         &mt('As a general rule, only authors or co-authors should be '.
                   2512:             'filesystem authenticated '.
                   2513:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2514:     return $result;
                   2515: }
                   2516: 
                   2517: sub authform_nochange{  
                   2518:     my %in = (
                   2519:               formname => 'document.cu',
                   2520:               kerb_def_dom => 'MSU.EDU',
                   2521:               @_,
                   2522:           );
1.586     raeburn  2523:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2524:     my $result;
                   2525:     if (keys(%can_assign) == 0) {
                   2526:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2527:     } else {
                   2528:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2529:                   '<input type="radio" name="login" value="nochange" '.
                   2530:                   'checked="checked" onclick="'.
1.281     albertel 2531:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2532: 	    '</label>';
1.586     raeburn  2533:     }
1.32      matthew  2534:     return $result;
                   2535: }
                   2536: 
1.591     raeburn  2537: sub authform_kerberos {
1.32      matthew  2538:     my %in = (
                   2539:               formname => 'document.cu',
                   2540:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2541:               kerb_def_auth => 'krb4',
1.32      matthew  2542:               @_,
                   2543:               );
1.586     raeburn  2544:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2545:         $autharg,$jscall);
                   2546:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2547:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2548:        $check5 = ' checked="checked"';
1.80      albertel 2549:     } else {
1.772     bisitz   2550:        $check4 = ' checked="checked"';
1.80      albertel 2551:     }
1.165     raeburn  2552:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2553:     if (defined($in{'curr_authtype'})) {
                   2554:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2555:             $krbcheck = ' checked="checked"';
1.623     raeburn  2556:             if (defined($in{'mode'})) {
                   2557:                 if ($in{'mode'} eq 'modifyuser') {
                   2558:                     $krbcheck = '';
                   2559:                 }
                   2560:             }
1.591     raeburn  2561:             if (defined($in{'curr_kerb_ver'})) {
                   2562:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2563:                     $check5 = ' checked="checked"';
1.591     raeburn  2564:                     $check4 = '';
                   2565:                 } else {
1.772     bisitz   2566:                     $check4 = ' checked="checked"';
1.591     raeburn  2567:                     $check5 = '';
                   2568:                 }
1.586     raeburn  2569:             }
1.591     raeburn  2570:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2571:                 $krbarg = $in{'curr_autharg'};
                   2572:             }
1.586     raeburn  2573:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2574:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2575:                     $result = 
                   2576:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2577:         $in{'curr_autharg'},$krbver);
                   2578:                 } else {
                   2579:                     $result =
                   2580:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2581:                 }
                   2582:                 return $result; 
                   2583:             }
                   2584:         }
                   2585:     } else {
                   2586:         if ($authnum == 1) {
1.784     bisitz   2587:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2588:         }
                   2589:     }
1.586     raeburn  2590:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2591:         return;
1.587     raeburn  2592:     } elsif ($authtype eq '') {
1.591     raeburn  2593:         if (defined($in{'mode'})) {
1.587     raeburn  2594:             if ($in{'mode'} eq 'modifycourse') {
                   2595:                 if ($authnum == 1) {
1.784     bisitz   2596:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2597:                 }
                   2598:             }
                   2599:         }
1.586     raeburn  2600:     }
                   2601:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2602:     if ($authtype eq '') {
                   2603:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2604:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2605:                     $krbcheck.' />';
                   2606:     }
                   2607:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2608:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2609:          $in{'curr_authtype'} eq 'krb5') ||
                   2610:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2611:          $in{'curr_authtype'} eq 'krb4')) {
                   2612:         $result .= &mt
1.144     matthew  2613:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2614:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2615:          '<label>'.$authtype,
1.281     albertel 2616:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2617:              'value="'.$krbarg.'" '.
1.144     matthew  2618:              'onchange="'.$jscall.'" />',
1.281     albertel 2619:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2620:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2621: 	 '</label>');
1.586     raeburn  2622:     } elsif ($can_assign{'krb4'}) {
                   2623:         $result .= &mt
                   2624:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2625:          '[_3] Version 4 [_4]',
                   2626:          '<label>'.$authtype,
                   2627:          '</label><input type="text" size="10" name="krbarg" '.
                   2628:              'value="'.$krbarg.'" '.
                   2629:              'onchange="'.$jscall.'" />',
                   2630:          '<label><input type="hidden" name="krbver" value="4" />',
                   2631:          '</label>');
                   2632:     } elsif ($can_assign{'krb5'}) {
                   2633:         $result .= &mt
                   2634:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2635:          '[_3] Version 5 [_4]',
                   2636:          '<label>'.$authtype,
                   2637:          '</label><input type="text" size="10" name="krbarg" '.
                   2638:              'value="'.$krbarg.'" '.
                   2639:              'onchange="'.$jscall.'" />',
                   2640:          '<label><input type="hidden" name="krbver" value="5" />',
                   2641:          '</label>');
                   2642:     }
1.32      matthew  2643:     return $result;
                   2644: }
                   2645: 
                   2646: sub authform_internal{  
1.586     raeburn  2647:     my %in = (
1.32      matthew  2648:                 formname => 'document.cu',
                   2649:                 kerb_def_dom => 'MSU.EDU',
                   2650:                 @_,
                   2651:                 );
1.586     raeburn  2652:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2653:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2654:     if (defined($in{'curr_authtype'})) {
                   2655:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2656:             if ($can_assign{'int'}) {
1.772     bisitz   2657:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2658:                 if (defined($in{'mode'})) {
                   2659:                     if ($in{'mode'} eq 'modifyuser') {
                   2660:                         $intcheck = '';
                   2661:                     }
                   2662:                 }
1.591     raeburn  2663:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2664:                     $intarg = $in{'curr_autharg'};
                   2665:                 }
                   2666:             } else {
                   2667:                 $result = &mt('Currently internally authenticated.');
                   2668:                 return $result;
1.165     raeburn  2669:             }
                   2670:         }
1.586     raeburn  2671:     } else {
                   2672:         if ($authnum == 1) {
1.784     bisitz   2673:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2674:         }
                   2675:     }
                   2676:     if (!$can_assign{'int'}) {
                   2677:         return;
1.587     raeburn  2678:     } elsif ($authtype eq '') {
1.591     raeburn  2679:         if (defined($in{'mode'})) {
1.587     raeburn  2680:             if ($in{'mode'} eq 'modifycourse') {
                   2681:                 if ($authnum == 1) {
1.784     bisitz   2682:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2683:                 }
                   2684:             }
                   2685:         }
1.165     raeburn  2686:     }
1.586     raeburn  2687:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2688:     if ($authtype eq '') {
                   2689:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2690:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2691:     }
1.605     bisitz   2692:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2693:                $intarg.'" onchange="'.$jscall.'" />';
                   2694:     $result = &mt
1.144     matthew  2695:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2696:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2697:     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  2698:     return $result;
                   2699: }
                   2700: 
                   2701: sub authform_local{  
                   2702:     my %in = (
                   2703:               formname => 'document.cu',
                   2704:               kerb_def_dom => 'MSU.EDU',
                   2705:               @_,
                   2706:               );
1.586     raeburn  2707:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2708:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2709:     if (defined($in{'curr_authtype'})) {
                   2710:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2711:             if ($can_assign{'loc'}) {
1.772     bisitz   2712:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2713:                 if (defined($in{'mode'})) {
                   2714:                     if ($in{'mode'} eq 'modifyuser') {
                   2715:                         $loccheck = '';
                   2716:                     }
                   2717:                 }
1.591     raeburn  2718:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2719:                     $locarg = $in{'curr_autharg'};
                   2720:                 }
                   2721:             } else {
                   2722:                 $result = &mt('Currently using local (institutional) authentication.');
                   2723:                 return $result;
1.165     raeburn  2724:             }
                   2725:         }
1.586     raeburn  2726:     } else {
                   2727:         if ($authnum == 1) {
1.784     bisitz   2728:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2729:         }
                   2730:     }
                   2731:     if (!$can_assign{'loc'}) {
                   2732:         return;
1.587     raeburn  2733:     } elsif ($authtype eq '') {
1.591     raeburn  2734:         if (defined($in{'mode'})) {
1.587     raeburn  2735:             if ($in{'mode'} eq 'modifycourse') {
                   2736:                 if ($authnum == 1) {
1.784     bisitz   2737:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2738:                 }
                   2739:             }
                   2740:         }
1.165     raeburn  2741:     }
1.586     raeburn  2742:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2743:     if ($authtype eq '') {
                   2744:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2745:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2746:                     $jscall.'" />';
                   2747:     }
                   2748:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2749:                $locarg.'" onchange="'.$jscall.'" />';
                   2750:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2751:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2752:     return $result;
                   2753: }
                   2754: 
                   2755: sub authform_filesystem{  
                   2756:     my %in = (
                   2757:               formname => 'document.cu',
                   2758:               kerb_def_dom => 'MSU.EDU',
                   2759:               @_,
                   2760:               );
1.586     raeburn  2761:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2762:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2763:     if (defined($in{'curr_authtype'})) {
                   2764:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2765:             if ($can_assign{'fsys'}) {
1.772     bisitz   2766:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2767:                 if (defined($in{'mode'})) {
                   2768:                     if ($in{'mode'} eq 'modifyuser') {
                   2769:                         $fsyscheck = '';
                   2770:                     }
                   2771:                 }
1.586     raeburn  2772:             } else {
                   2773:                 $result = &mt('Currently Filesystem Authenticated.');
                   2774:                 return $result;
                   2775:             }           
                   2776:         }
                   2777:     } else {
                   2778:         if ($authnum == 1) {
1.784     bisitz   2779:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2780:         }
                   2781:     }
                   2782:     if (!$can_assign{'fsys'}) {
                   2783:         return;
1.587     raeburn  2784:     } elsif ($authtype eq '') {
1.591     raeburn  2785:         if (defined($in{'mode'})) {
1.587     raeburn  2786:             if ($in{'mode'} eq 'modifycourse') {
                   2787:                 if ($authnum == 1) {
1.784     bisitz   2788:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2789:                 }
                   2790:             }
                   2791:         }
1.586     raeburn  2792:     }
                   2793:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2794:     if ($authtype eq '') {
                   2795:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2796:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2797:                     $jscall.'" />';
                   2798:     }
                   2799:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2800:                ' onchange="'.$jscall.'" />';
                   2801:     $result = &mt
1.144     matthew  2802:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2803:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2804:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2805:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2806:                   'onchange="'.$jscall.'" />');
1.32      matthew  2807:     return $result;
                   2808: }
                   2809: 
1.586     raeburn  2810: sub get_assignable_auth {
                   2811:     my ($dom) = @_;
                   2812:     if ($dom eq '') {
                   2813:         $dom = $env{'request.role.domain'};
                   2814:     }
                   2815:     my %can_assign = (
                   2816:                           krb4 => 1,
                   2817:                           krb5 => 1,
                   2818:                           int  => 1,
                   2819:                           loc  => 1,
                   2820:                      );
                   2821:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2822:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2823:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2824:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2825:             my $context;
                   2826:             if ($env{'request.role'} =~ /^au/) {
                   2827:                 $context = 'author';
                   2828:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2829:                 $context = 'domain';
                   2830:             } elsif ($env{'request.course.id'}) {
                   2831:                 $context = 'course';
                   2832:             }
                   2833:             if ($context) {
                   2834:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2835:                    %can_assign = %{$authhash->{$context}}; 
                   2836:                 }
                   2837:             }
                   2838:         }
                   2839:     }
                   2840:     my $authnum = 0;
                   2841:     foreach my $key (keys(%can_assign)) {
                   2842:         if ($can_assign{$key}) {
                   2843:             $authnum ++;
                   2844:         }
                   2845:     }
                   2846:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2847:         $authnum --;
                   2848:     }
                   2849:     return ($authnum,%can_assign);
                   2850: }
                   2851: 
1.80      albertel 2852: ###############################################################
                   2853: ##    Get Kerberos Defaults for Domain                 ##
                   2854: ###############################################################
                   2855: ##
                   2856: ## Returns default kerberos version and an associated argument
                   2857: ## as listed in file domain.tab. If not listed, provides
                   2858: ## appropriate default domain and kerberos version.
                   2859: ##
                   2860: #-------------------------------------------
                   2861: 
                   2862: =pod
                   2863: 
1.648     raeburn  2864: =item * &get_kerberos_defaults()
1.80      albertel 2865: 
                   2866: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2867: version and domain. If not found, it defaults to version 4 and the 
                   2868: domain of the server.
1.80      albertel 2869: 
1.648     raeburn  2870: =over 4
                   2871: 
1.80      albertel 2872: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2873: 
1.648     raeburn  2874: =back
                   2875: 
                   2876: =back
                   2877: 
1.80      albertel 2878: =cut
                   2879: 
                   2880: #-------------------------------------------
                   2881: sub get_kerberos_defaults {
                   2882:     my $domain=shift;
1.641     raeburn  2883:     my ($krbdef,$krbdefdom);
                   2884:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2885:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2886:         $krbdef = $domdefaults{'auth_def'};
                   2887:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2888:     } else {
1.80      albertel 2889:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2890:         my $krbdefdom=$1;
                   2891:         $krbdefdom=~tr/a-z/A-Z/;
                   2892:         $krbdef = "krb4";
                   2893:     }
                   2894:     return ($krbdef,$krbdefdom);
                   2895: }
1.112     bowersj2 2896: 
1.32      matthew  2897: 
1.46      matthew  2898: ###############################################################
                   2899: ##                Thesaurus Functions                        ##
                   2900: ###############################################################
1.20      www      2901: 
1.46      matthew  2902: =pod
1.20      www      2903: 
1.112     bowersj2 2904: =head1 Thesaurus Functions
                   2905: 
                   2906: =over 4
                   2907: 
1.648     raeburn  2908: =item * &initialize_keywords()
1.46      matthew  2909: 
                   2910: Initializes the package variable %Keywords if it is empty.  Uses the
                   2911: package variable $thesaurus_db_file.
                   2912: 
                   2913: =cut
                   2914: 
                   2915: ###################################################
                   2916: 
                   2917: sub initialize_keywords {
                   2918:     return 1 if (scalar keys(%Keywords));
                   2919:     # If we are here, %Keywords is empty, so fill it up
                   2920:     #   Make sure the file we need exists...
                   2921:     if (! -e $thesaurus_db_file) {
                   2922:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2923:                                  " failed because it does not exist");
                   2924:         return 0;
                   2925:     }
                   2926:     #   Set up the hash as a database
                   2927:     my %thesaurus_db;
                   2928:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2929:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2930:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2931:                                  $thesaurus_db_file);
                   2932:         return 0;
                   2933:     } 
                   2934:     #  Get the average number of appearances of a word.
                   2935:     my $avecount = $thesaurus_db{'average.count'};
                   2936:     #  Put keywords (those that appear > average) into %Keywords
                   2937:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2938:         my ($count,undef) = split /:/,$data;
                   2939:         $Keywords{$word}++ if ($count > $avecount);
                   2940:     }
                   2941:     untie %thesaurus_db;
                   2942:     # Remove special values from %Keywords.
1.356     albertel 2943:     foreach my $value ('total.count','average.count') {
                   2944:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2945:   }
1.46      matthew  2946:     return 1;
                   2947: }
                   2948: 
                   2949: ###################################################
                   2950: 
                   2951: =pod
                   2952: 
1.648     raeburn  2953: =item * &keyword($word)
1.46      matthew  2954: 
                   2955: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2956: than the average number of times in the thesaurus database.  Calls 
                   2957: &initialize_keywords
                   2958: 
                   2959: =cut
                   2960: 
                   2961: ###################################################
1.20      www      2962: 
                   2963: sub keyword {
1.46      matthew  2964:     return if (!&initialize_keywords());
                   2965:     my $word=lc(shift());
                   2966:     $word=~s/\W//g;
                   2967:     return exists($Keywords{$word});
1.20      www      2968: }
1.46      matthew  2969: 
                   2970: ###############################################################
                   2971: 
                   2972: =pod 
1.20      www      2973: 
1.648     raeburn  2974: =item * &get_related_words()
1.46      matthew  2975: 
1.160     matthew  2976: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2977: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2978: will be returned.  The order of the words returned is determined by the
                   2979: database which holds them.
                   2980: 
                   2981: Uses global $thesaurus_db_file.
                   2982: 
1.1057    foxr     2983: 
1.46      matthew  2984: =cut
                   2985: 
                   2986: ###############################################################
                   2987: sub get_related_words {
                   2988:     my $keyword = shift;
                   2989:     my %thesaurus_db;
                   2990:     if (! -e $thesaurus_db_file) {
                   2991:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2992:                                  "failed because the file does not exist");
                   2993:         return ();
                   2994:     }
                   2995:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2996:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2997:         return ();
                   2998:     } 
                   2999:     my @Words=();
1.429     www      3000:     my $count=0;
1.46      matthew  3001:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3002: 	# The first element is the number of times
                   3003: 	# the word appears.  We do not need it now.
1.429     www      3004: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3005: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3006: 	my $threshold=$mostfrequentcount/10;
                   3007:         foreach my $possibleword (@RelatedWords) {
                   3008:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3009:             if ($wordcount>$threshold) {
                   3010: 		push(@Words,$word);
                   3011:                 $count++;
                   3012:                 if ($count>10) { last; }
                   3013: 	    }
1.20      www      3014:         }
                   3015:     }
1.46      matthew  3016:     untie %thesaurus_db;
                   3017:     return @Words;
1.14      harris41 3018: }
1.1090    foxr     3019: ###############################################################
                   3020: #
                   3021: #  Spell checking
                   3022: #
                   3023: 
                   3024: =pod
                   3025: 
                   3026: =head1 Spell checking
                   3027: 
                   3028: =over 4
                   3029: 
                   3030: =item * &check_spelling($wordlist $language)
                   3031: 
                   3032: Takes a string containing words and feeds it to an external
                   3033: spellcheck program via a pipeline. Returns a string containing
                   3034: them mis-spelled words.
                   3035: 
                   3036: Parameters:
                   3037: 
                   3038: =over 4
                   3039: 
                   3040: =item - $wordlist
                   3041: 
                   3042: String that will be fed into the spellcheck program.
                   3043: 
                   3044: =item - $language
                   3045: 
                   3046: Language string that specifies the language for which the spell
                   3047: check will be performed.
                   3048: 
                   3049: =back
                   3050: 
                   3051: =back
                   3052: 
                   3053: Note: This sub assumes that aspell is installed.
                   3054: 
                   3055: 
                   3056: =cut
                   3057: 
1.46      matthew  3058: 
1.112     bowersj2 3059: =pod
                   3060: 
                   3061: =back
                   3062: 
                   3063: =cut
1.61      www      3064: 
1.1090    foxr     3065: sub check_spelling {
                   3066:     my ($wordlist, $language) = @_;
1.1091    foxr     3067:     my @misspellings;
                   3068:     
                   3069:     # Generate the speller and set the langauge.
                   3070:     # if explicitly selected:
1.1090    foxr     3071: 
1.1091    foxr     3072:     my $speller = Text::Aspell->new;
1.1090    foxr     3073:     if ($language) {
1.1091    foxr     3074: 	$speller->set_option('lang', $language);
1.1090    foxr     3075:     }
                   3076: 
1.1091    foxr     3077:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3078: 
1.1091    foxr     3079:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3080: 
1.1091    foxr     3081:     foreach my $word (@words) {
                   3082: 	if(! $speller->check($word)) {
                   3083: 	    push(@misspellings, $word);
1.1090    foxr     3084: 	}
                   3085:     }
1.1091    foxr     3086:     return join(' ', @misspellings);
                   3087:     
1.1090    foxr     3088: }
                   3089: 
1.61      www      3090: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3091: =pod
                   3092: 
1.112     bowersj2 3093: =head1 User Name Functions
                   3094: 
                   3095: =over 4
                   3096: 
1.648     raeburn  3097: =item * &plainname($uname,$udom,$first)
1.81      albertel 3098: 
1.112     bowersj2 3099: Takes a users logon name and returns it as a string in
1.226     albertel 3100: "first middle last generation" form 
                   3101: if $first is set to 'lastname' then it returns it as
                   3102: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3103: 
                   3104: =cut
1.61      www      3105: 
1.295     www      3106: 
1.81      albertel 3107: ###############################################################
1.61      www      3108: sub plainname {
1.226     albertel 3109:     my ($uname,$udom,$first)=@_;
1.537     albertel 3110:     return if (!defined($uname) || !defined($udom));
1.295     www      3111:     my %names=&getnames($uname,$udom);
1.226     albertel 3112:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3113: 					  $names{'middlename'},
                   3114: 					  $names{'lastname'},
                   3115: 					  $names{'generation'},$first);
                   3116:     $name=~s/^\s+//;
1.62      www      3117:     $name=~s/\s+$//;
                   3118:     $name=~s/\s+/ /g;
1.353     albertel 3119:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3120:     return $name;
1.61      www      3121: }
1.66      www      3122: 
                   3123: # -------------------------------------------------------------------- Nickname
1.81      albertel 3124: =pod
                   3125: 
1.648     raeburn  3126: =item * &nickname($uname,$udom)
1.81      albertel 3127: 
                   3128: Gets a users name and returns it as a string as
                   3129: 
                   3130: "&quot;nickname&quot;"
1.66      www      3131: 
1.81      albertel 3132: if the user has a nickname or
                   3133: 
                   3134: "first middle last generation"
                   3135: 
                   3136: if the user does not
                   3137: 
                   3138: =cut
1.66      www      3139: 
                   3140: sub nickname {
                   3141:     my ($uname,$udom)=@_;
1.537     albertel 3142:     return if (!defined($uname) || !defined($udom));
1.295     www      3143:     my %names=&getnames($uname,$udom);
1.68      albertel 3144:     my $name=$names{'nickname'};
1.66      www      3145:     if ($name) {
                   3146:        $name='&quot;'.$name.'&quot;'; 
                   3147:     } else {
                   3148:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3149: 	     $names{'lastname'}.' '.$names{'generation'};
                   3150:        $name=~s/\s+$//;
                   3151:        $name=~s/\s+/ /g;
                   3152:     }
                   3153:     return $name;
                   3154: }
                   3155: 
1.295     www      3156: sub getnames {
                   3157:     my ($uname,$udom)=@_;
1.537     albertel 3158:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3159:     if ($udom eq 'public' && $uname eq 'public') {
                   3160: 	return ('lastname' => &mt('Public'));
                   3161:     }
1.295     www      3162:     my $id=$uname.':'.$udom;
                   3163:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3164:     if ($cached) {
                   3165: 	return %{$names};
                   3166:     } else {
                   3167: 	my %loadnames=&Apache::lonnet::get('environment',
                   3168:                     ['firstname','middlename','lastname','generation','nickname'],
                   3169: 					 $udom,$uname);
                   3170: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3171: 	return %loadnames;
                   3172:     }
                   3173: }
1.61      www      3174: 
1.542     raeburn  3175: # -------------------------------------------------------------------- getemails
1.648     raeburn  3176: 
1.542     raeburn  3177: =pod
                   3178: 
1.648     raeburn  3179: =item * &getemails($uname,$udom)
1.542     raeburn  3180: 
                   3181: Gets a user's email information and returns it as a hash with keys:
                   3182: notification, critnotification, permanentemail
                   3183: 
                   3184: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3185: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3186:  
1.648     raeburn  3187: 
1.542     raeburn  3188: =cut
                   3189: 
1.648     raeburn  3190: 
1.466     albertel 3191: sub getemails {
                   3192:     my ($uname,$udom)=@_;
                   3193:     if ($udom eq 'public' && $uname eq 'public') {
                   3194: 	return;
                   3195:     }
1.467     www      3196:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3197:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3198:     my $id=$uname.':'.$udom;
                   3199:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3200:     if ($cached) {
                   3201: 	return %{$names};
                   3202:     } else {
                   3203: 	my %loadnames=&Apache::lonnet::get('environment',
                   3204:                     			   ['notification','critnotification',
                   3205: 					    'permanentemail'],
                   3206: 					   $udom,$uname);
                   3207: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3208: 	return %loadnames;
                   3209:     }
                   3210: }
                   3211: 
1.551     albertel 3212: sub flush_email_cache {
                   3213:     my ($uname,$udom)=@_;
                   3214:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3215:     if (!$uname) { $uname=$env{'user.name'};   }
                   3216:     return if ($udom eq 'public' && $uname eq 'public');
                   3217:     my $id=$uname.':'.$udom;
                   3218:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3219: }
                   3220: 
1.728     raeburn  3221: # -------------------------------------------------------------------- getlangs
                   3222: 
                   3223: =pod
                   3224: 
                   3225: =item * &getlangs($uname,$udom)
                   3226: 
                   3227: Gets a user's language preference and returns it as a hash with key:
                   3228: language.
                   3229: 
                   3230: =cut
                   3231: 
                   3232: 
                   3233: sub getlangs {
                   3234:     my ($uname,$udom) = @_;
                   3235:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3236:     if (!$uname) { $uname=$env{'user.name'};   }
                   3237:     my $id=$uname.':'.$udom;
                   3238:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3239:     if ($cached) {
                   3240:         return %{$langs};
                   3241:     } else {
                   3242:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3243:                                            $udom,$uname);
                   3244:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3245:         return %loadlangs;
                   3246:     }
                   3247: }
                   3248: 
                   3249: sub flush_langs_cache {
                   3250:     my ($uname,$udom)=@_;
                   3251:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3252:     if (!$uname) { $uname=$env{'user.name'};   }
                   3253:     return if ($udom eq 'public' && $uname eq 'public');
                   3254:     my $id=$uname.':'.$udom;
                   3255:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3256: }
                   3257: 
1.61      www      3258: # ------------------------------------------------------------------ Screenname
1.81      albertel 3259: 
                   3260: =pod
                   3261: 
1.648     raeburn  3262: =item * &screenname($uname,$udom)
1.81      albertel 3263: 
                   3264: Gets a users screenname and returns it as a string
                   3265: 
                   3266: =cut
1.61      www      3267: 
                   3268: sub screenname {
                   3269:     my ($uname,$udom)=@_;
1.258     albertel 3270:     if ($uname eq $env{'user.name'} &&
                   3271: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3272:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3273:     return $names{'screenname'};
1.62      www      3274: }
                   3275: 
1.212     albertel 3276: 
1.802     bisitz   3277: # ------------------------------------------------------------- Confirm Wrapper
                   3278: =pod
                   3279: 
                   3280: =item confirmwrapper
                   3281: 
                   3282: Wrap messages about completion of operation in box
                   3283: 
                   3284: =cut
                   3285: 
                   3286: sub confirmwrapper {
                   3287:     my ($message)=@_;
                   3288:     if ($message) {
                   3289:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3290:                .$message."\n"
                   3291:                .'</div>'."\n";
                   3292:     } else {
                   3293:         return $message;
                   3294:     }
                   3295: }
                   3296: 
1.62      www      3297: # ------------------------------------------------------------- Message Wrapper
                   3298: 
                   3299: sub messagewrapper {
1.369     www      3300:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3301:     return 
1.441     albertel 3302:         '<a href="/adm/email?compose=individual&amp;'.
                   3303:         'recname='.$username.'&amp;recdom='.$domain.
                   3304: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3305:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3306: }
1.802     bisitz   3307: 
1.74      www      3308: # --------------------------------------------------------------- Notes Wrapper
                   3309: 
                   3310: sub noteswrapper {
                   3311:     my ($link,$un,$do)=@_;
                   3312:     return 
1.896     amueller 3313: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3314: }
1.802     bisitz   3315: 
1.62      www      3316: # ------------------------------------------------------------- Aboutme Wrapper
                   3317: 
                   3318: sub aboutmewrapper {
1.1070    raeburn  3319:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3320:     if (!defined($username)  && !defined($domain)) {
                   3321:         return;
                   3322:     }
1.892     amueller 3323:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.1070    raeburn  3324: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3325: }
                   3326: 
                   3327: # ------------------------------------------------------------ Syllabus Wrapper
                   3328: 
                   3329: sub syllabuswrapper {
1.707     bisitz   3330:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3331:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3332: }
1.14      harris41 3333: 
1.802     bisitz   3334: # -----------------------------------------------------------------------------
                   3335: 
1.208     matthew  3336: sub track_student_link {
1.887     raeburn  3337:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3338:     my $link ="/adm/trackstudent?";
1.208     matthew  3339:     my $title = 'View recent activity';
                   3340:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3341:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3342:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3343:         $title .= ' of this student';
1.268     albertel 3344:     } 
1.208     matthew  3345:     if (defined($target) && $target !~ /^\s*$/) {
                   3346:         $target = qq{target="$target"};
                   3347:     } else {
                   3348:         $target = '';
                   3349:     }
1.268     albertel 3350:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3351:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3352:     $title = &mt($title);
                   3353:     $linktext = &mt($linktext);
1.448     albertel 3354:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3355: 	&help_open_topic('View_recent_activity');
1.208     matthew  3356: }
                   3357: 
1.781     raeburn  3358: sub slot_reservations_link {
                   3359:     my ($linktext,$sname,$sdom,$target) = @_;
                   3360:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3361:     my $title = 'View slot reservation history';
                   3362:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3363:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3364:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3365:         $title .= ' of this student';
                   3366:     }
                   3367:     if (defined($target) && $target !~ /^\s*$/) {
                   3368:         $target = qq{target="$target"};
                   3369:     } else {
                   3370:         $target = '';
                   3371:     }
                   3372:     $title = &mt($title);
                   3373:     $linktext = &mt($linktext);
                   3374:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3375: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3376: 
                   3377: }
                   3378: 
1.508     www      3379: # ===================================================== Display a student photo
                   3380: 
                   3381: 
1.509     albertel 3382: sub student_image_tag {
1.508     www      3383:     my ($domain,$user)=@_;
                   3384:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3385:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3386: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3387:     } else {
                   3388: 	return '';
                   3389:     }
                   3390: }
                   3391: 
1.112     bowersj2 3392: =pod
                   3393: 
                   3394: =back
                   3395: 
                   3396: =head1 Access .tab File Data
                   3397: 
                   3398: =over 4
                   3399: 
1.648     raeburn  3400: =item * &languageids() 
1.112     bowersj2 3401: 
                   3402: returns list of all language ids
                   3403: 
                   3404: =cut
                   3405: 
1.14      harris41 3406: sub languageids {
1.16      harris41 3407:     return sort(keys(%language));
1.14      harris41 3408: }
                   3409: 
1.112     bowersj2 3410: =pod
                   3411: 
1.648     raeburn  3412: =item * &languagedescription() 
1.112     bowersj2 3413: 
                   3414: returns description of a specified language id
                   3415: 
                   3416: =cut
                   3417: 
1.14      harris41 3418: sub languagedescription {
1.125     www      3419:     my $code=shift;
                   3420:     return  ($supported_language{$code}?'* ':'').
                   3421:             $language{$code}.
1.126     www      3422: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3423: }
                   3424: 
1.1048    foxr     3425: =pod
                   3426: 
                   3427: =item * &plainlanguagedescription
                   3428: 
                   3429: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3430: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3431: 
                   3432: =cut
                   3433: 
1.145     www      3434: sub plainlanguagedescription {
                   3435:     my $code=shift;
                   3436:     return $language{$code};
                   3437: }
                   3438: 
1.1048    foxr     3439: =pod
                   3440: 
                   3441: =item * &supportedlanguagecode
                   3442: 
                   3443: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3444: code.
                   3445: 
                   3446: =cut
                   3447: 
1.145     www      3448: sub supportedlanguagecode {
                   3449:     my $code=shift;
                   3450:     return $supported_language{$code};
1.97      www      3451: }
                   3452: 
1.112     bowersj2 3453: =pod
                   3454: 
1.1048    foxr     3455: =item * &latexlanguage()
                   3456: 
                   3457: Given a language key code returns the correspondnig language to use
                   3458: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3459: is no supported hyphenation for the language code.
                   3460: 
                   3461: =cut
                   3462: 
                   3463: sub latexlanguage {
                   3464:     my $code = shift;
                   3465:     return $latex_language{$code};
                   3466: }
                   3467: 
                   3468: =pod
                   3469: 
                   3470: =item * &latexhyphenation()
                   3471: 
                   3472: Same as above but what's supplied is the language as it might be stored
                   3473: in the metadata.
                   3474: 
                   3475: =cut
                   3476: 
                   3477: sub latexhyphenation {
                   3478:     my $key = shift;
                   3479:     return $latex_language_bykey{$key};
                   3480: }
                   3481: 
                   3482: =pod
                   3483: 
1.648     raeburn  3484: =item * &copyrightids() 
1.112     bowersj2 3485: 
                   3486: returns list of all copyrights
                   3487: 
                   3488: =cut
                   3489: 
                   3490: sub copyrightids {
                   3491:     return sort(keys(%cprtag));
                   3492: }
                   3493: 
                   3494: =pod
                   3495: 
1.648     raeburn  3496: =item * &copyrightdescription() 
1.112     bowersj2 3497: 
                   3498: returns description of a specified copyright id
                   3499: 
                   3500: =cut
                   3501: 
                   3502: sub copyrightdescription {
1.166     www      3503:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3504: }
1.197     matthew  3505: 
                   3506: =pod
                   3507: 
1.648     raeburn  3508: =item * &source_copyrightids() 
1.192     taceyjo1 3509: 
                   3510: returns list of all source copyrights
                   3511: 
                   3512: =cut
                   3513: 
                   3514: sub source_copyrightids {
                   3515:     return sort(keys(%scprtag));
                   3516: }
                   3517: 
                   3518: =pod
                   3519: 
1.648     raeburn  3520: =item * &source_copyrightdescription() 
1.192     taceyjo1 3521: 
                   3522: returns description of a specified source copyright id
                   3523: 
                   3524: =cut
                   3525: 
                   3526: sub source_copyrightdescription {
                   3527:     return &mt($scprtag{shift(@_)});
                   3528: }
1.112     bowersj2 3529: 
                   3530: =pod
                   3531: 
1.648     raeburn  3532: =item * &filecategories() 
1.112     bowersj2 3533: 
                   3534: returns list of all file categories
                   3535: 
                   3536: =cut
                   3537: 
                   3538: sub filecategories {
                   3539:     return sort(keys(%category_extensions));
                   3540: }
                   3541: 
                   3542: =pod
                   3543: 
1.648     raeburn  3544: =item * &filecategorytypes() 
1.112     bowersj2 3545: 
                   3546: returns list of file types belonging to a given file
                   3547: category
                   3548: 
                   3549: =cut
                   3550: 
                   3551: sub filecategorytypes {
1.356     albertel 3552:     my ($cat) = @_;
                   3553:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3554: }
                   3555: 
                   3556: =pod
                   3557: 
1.648     raeburn  3558: =item * &fileembstyle() 
1.112     bowersj2 3559: 
                   3560: returns embedding style for a specified file type
                   3561: 
                   3562: =cut
                   3563: 
                   3564: sub fileembstyle {
                   3565:     return $fe{lc(shift(@_))};
1.169     www      3566: }
                   3567: 
1.351     www      3568: sub filemimetype {
                   3569:     return $fm{lc(shift(@_))};
                   3570: }
                   3571: 
1.169     www      3572: 
                   3573: sub filecategoryselect {
                   3574:     my ($name,$value)=@_;
1.189     matthew  3575:     return &select_form($value,$name,
1.970     raeburn  3576:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3577: }
                   3578: 
                   3579: =pod
                   3580: 
1.648     raeburn  3581: =item * &filedescription() 
1.112     bowersj2 3582: 
                   3583: returns description for a specified file type
                   3584: 
                   3585: =cut
                   3586: 
                   3587: sub filedescription {
1.188     matthew  3588:     my $file_description = $fd{lc(shift())};
                   3589:     $file_description =~ s:([\[\]]):~$1:g;
                   3590:     return &mt($file_description);
1.112     bowersj2 3591: }
                   3592: 
                   3593: =pod
                   3594: 
1.648     raeburn  3595: =item * &filedescriptionex() 
1.112     bowersj2 3596: 
                   3597: returns description for a specified file type with
                   3598: extra formatting
                   3599: 
                   3600: =cut
                   3601: 
                   3602: sub filedescriptionex {
                   3603:     my $ex=shift;
1.188     matthew  3604:     my $file_description = $fd{lc($ex)};
                   3605:     $file_description =~ s:([\[\]]):~$1:g;
                   3606:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3607: }
                   3608: 
                   3609: # End of .tab access
                   3610: =pod
                   3611: 
                   3612: =back
                   3613: 
                   3614: =cut
                   3615: 
                   3616: # ------------------------------------------------------------------ File Types
                   3617: sub fileextensions {
                   3618:     return sort(keys(%fe));
                   3619: }
                   3620: 
1.97      www      3621: # ----------------------------------------------------------- Display Languages
                   3622: # returns a hash with all desired display languages
                   3623: #
                   3624: 
                   3625: sub display_languages {
                   3626:     my %languages=();
1.695     raeburn  3627:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3628: 	$languages{$lang}=1;
1.97      www      3629:     }
                   3630:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3631:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3632: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3633: 	    $languages{$lang}=1;
1.97      www      3634:         }
                   3635:     }
                   3636:     return %languages;
1.14      harris41 3637: }
                   3638: 
1.582     albertel 3639: sub languages {
                   3640:     my ($possible_langs) = @_;
1.695     raeburn  3641:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3642:     if (!ref($possible_langs)) {
                   3643: 	if( wantarray ) {
                   3644: 	    return @preferred_langs;
                   3645: 	} else {
                   3646: 	    return $preferred_langs[0];
                   3647: 	}
                   3648:     }
                   3649:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3650:     my @preferred_possibilities;
                   3651:     foreach my $preferred_lang (@preferred_langs) {
                   3652: 	if (exists($possibilities{$preferred_lang})) {
                   3653: 	    push(@preferred_possibilities, $preferred_lang);
                   3654: 	}
                   3655:     }
                   3656:     if( wantarray ) {
                   3657: 	return @preferred_possibilities;
                   3658:     }
                   3659:     return $preferred_possibilities[0];
                   3660: }
                   3661: 
1.742     raeburn  3662: sub user_lang {
                   3663:     my ($touname,$toudom,$fromcid) = @_;
                   3664:     my @userlangs;
                   3665:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3666:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3667:                     $env{'course.'.$fromcid.'.languages'}));
                   3668:     } else {
                   3669:         my %langhash = &getlangs($touname,$toudom);
                   3670:         if ($langhash{'languages'} ne '') {
                   3671:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3672:         } else {
                   3673:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3674:             if ($domdefs{'lang_def'} ne '') {
                   3675:                 @userlangs = ($domdefs{'lang_def'});
                   3676:             }
                   3677:         }
                   3678:     }
                   3679:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3680:     my $user_lh = Apache::localize->get_handle(@languages);
                   3681:     return $user_lh;
                   3682: }
                   3683: 
                   3684: 
1.112     bowersj2 3685: ###############################################################
                   3686: ##               Student Answer Attempts                     ##
                   3687: ###############################################################
                   3688: 
                   3689: =pod
                   3690: 
                   3691: =head1 Alternate Problem Views
                   3692: 
                   3693: =over 4
                   3694: 
1.648     raeburn  3695: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3696:     $getattempt, $regexp, $gradesub)
                   3697: 
                   3698: Return string with previous attempt on problem. Arguments:
                   3699: 
                   3700: =over 4
                   3701: 
                   3702: =item * $symb: Problem, including path
                   3703: 
                   3704: =item * $username: username of the desired student
                   3705: 
                   3706: =item * $domain: domain of the desired student
1.14      harris41 3707: 
1.112     bowersj2 3708: =item * $course: Course ID
1.14      harris41 3709: 
1.112     bowersj2 3710: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3711:     something
1.14      harris41 3712: 
1.112     bowersj2 3713: =item * $regexp: if string matches this regexp, the string will be
                   3714:     sent to $gradesub
1.14      harris41 3715: 
1.112     bowersj2 3716: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3717: 
1.112     bowersj2 3718: =back
1.14      harris41 3719: 
1.112     bowersj2 3720: The output string is a table containing all desired attempts, if any.
1.16      harris41 3721: 
1.112     bowersj2 3722: =cut
1.1       albertel 3723: 
                   3724: sub get_previous_attempt {
1.43      ng       3725:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3726:   my $prevattempts='';
1.43      ng       3727:   no strict 'refs';
1.1       albertel 3728:   if ($symb) {
1.3       albertel 3729:     my (%returnhash)=
                   3730:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3731:     if ($returnhash{'version'}) {
                   3732:       my %lasthash=();
                   3733:       my $version;
                   3734:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3735:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3736: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3737:         }
1.1       albertel 3738:       }
1.596     albertel 3739:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3740:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3741:       my (%typeparts,%lasthidden);
1.945     raeburn  3742:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3743:       foreach my $key (sort(keys(%lasthash))) {
                   3744: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3745: 	if ($#parts > 0) {
1.31      albertel 3746: 	  my $data=$parts[-1];
1.989     raeburn  3747:           next if ($data eq 'foilorder');
1.31      albertel 3748: 	  pop(@parts);
1.1010    www      3749:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3750:           if ($data eq 'type') {
                   3751:               unless ($showsurv) {
                   3752:                   my $id = join(',',@parts);
                   3753:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3754:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3755:                       $lasthidden{$ign.'.'.$id} = 1;
                   3756:                   }
1.945     raeburn  3757:               }
1.1010    www      3758:           } 
1.31      albertel 3759: 	} else {
1.41      ng       3760: 	  if ($#parts == 0) {
                   3761: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3762: 	  } else {
                   3763: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3764: 	  }
1.31      albertel 3765: 	}
1.16      harris41 3766:       }
1.596     albertel 3767:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3768:       if ($getattempt eq '') {
                   3769: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3770:             my @hidden;
                   3771:             if (%typeparts) {
                   3772:                 foreach my $id (keys(%typeparts)) {
                   3773:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3774:                         push(@hidden,$id);
                   3775:                     }
                   3776:                 }
                   3777:             }
                   3778:             $prevattempts.=&start_data_table_row().
                   3779:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3780:             if (@hidden) {
                   3781:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3782:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3783:                     my $hide;
                   3784:                     foreach my $id (@hidden) {
                   3785:                         if ($key =~ /^\Q$id\E/) {
                   3786:                             $hide = 1;
                   3787:                             last;
                   3788:                         }
                   3789:                     }
                   3790:                     if ($hide) {
                   3791:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3792:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3793:                             my $value = &format_previous_attempt_value($key,
                   3794:                                              $returnhash{$version.':'.$key});
                   3795:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3796:                         } else {
                   3797:                             $prevattempts.='<td>&nbsp;</td>';
                   3798:                         }
                   3799:                     } else {
                   3800:                         if ($key =~ /\./) {
                   3801:                             my $value = &format_previous_attempt_value($key,
                   3802:                                               $returnhash{$version.':'.$key});
                   3803:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3804:                         } else {
                   3805:                             $prevattempts.='<td>&nbsp;</td>';
                   3806:                         }
                   3807:                     }
                   3808:                 }
                   3809:             } else {
                   3810: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3811:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3812: 		    my $value = &format_previous_attempt_value($key,
                   3813: 			            $returnhash{$version.':'.$key});
                   3814: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3815: 	        }
                   3816:             }
                   3817: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3818: 	 }
1.1       albertel 3819:       }
1.945     raeburn  3820:       my @currhidden = keys(%lasthidden);
1.596     albertel 3821:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3822:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3823:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3824:           if (%typeparts) {
                   3825:               my $hidden;
                   3826:               foreach my $id (@currhidden) {
                   3827:                   if ($key =~ /^\Q$id\E/) {
                   3828:                       $hidden = 1;
                   3829:                       last;
                   3830:                   }
                   3831:               }
                   3832:               if ($hidden) {
                   3833:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3834:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3835:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3836:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3837:                           $value = &$gradesub($value);
                   3838:                       }
                   3839:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3840:                   } else {
                   3841:                       $prevattempts.='<td>&nbsp;</td>';
                   3842:                   }
                   3843:               } else {
                   3844:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3845:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3846:                       $value = &$gradesub($value);
                   3847:                   }
                   3848:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3849:               }
                   3850:           } else {
                   3851: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3852: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3853:                   $value = &$gradesub($value);
                   3854:               }
                   3855: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3856:           }
1.16      harris41 3857:       }
1.596     albertel 3858:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3859:     } else {
1.596     albertel 3860:       $prevattempts=
                   3861: 	  &start_data_table().&start_data_table_row().
                   3862: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3863: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3864:     }
                   3865:   } else {
1.596     albertel 3866:     $prevattempts=
                   3867: 	  &start_data_table().&start_data_table_row().
                   3868: 	  '<td>'.&mt('No data.').'</td>'.
                   3869: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3870:   }
1.10      albertel 3871: }
                   3872: 
1.581     albertel 3873: sub format_previous_attempt_value {
                   3874:     my ($key,$value) = @_;
1.1011    www      3875:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3876: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3877:     } elsif (ref($value) eq 'ARRAY') {
                   3878: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3879:     } elsif ($key =~ /answerstring$/) {
                   3880:         my %answers = &Apache::lonnet::str2hash($value);
                   3881:         my @anskeys = sort(keys(%answers));
                   3882:         if (@anskeys == 1) {
                   3883:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3884:             if ($answer =~ m{\0}) {
                   3885:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3886:             }
                   3887:             my $tag_internal_answer_name = 'INTERNAL';
                   3888:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3889:                 $value = $answer; 
                   3890:             } else {
                   3891:                 $value = $anskeys[0].'='.$answer;
                   3892:             }
                   3893:         } else {
                   3894:             foreach my $ans (@anskeys) {
                   3895:                 my $answer = $answers{$ans};
1.1001    raeburn  3896:                 if ($answer =~ m{\0}) {
                   3897:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3898:                 }
                   3899:                 $value .=  $ans.'='.$answer.'<br />';;
                   3900:             } 
                   3901:         }
1.581     albertel 3902:     } else {
                   3903: 	$value = &unescape($value);
                   3904:     }
                   3905:     return $value;
                   3906: }
                   3907: 
                   3908: 
1.107     albertel 3909: sub relative_to_absolute {
                   3910:     my ($url,$output)=@_;
                   3911:     my $parser=HTML::TokeParser->new(\$output);
                   3912:     my $token;
                   3913:     my $thisdir=$url;
                   3914:     my @rlinks=();
                   3915:     while ($token=$parser->get_token) {
                   3916: 	if ($token->[0] eq 'S') {
                   3917: 	    if ($token->[1] eq 'a') {
                   3918: 		if ($token->[2]->{'href'}) {
                   3919: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3920: 		}
                   3921: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3922: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3923: 	    } elsif ($token->[1] eq 'base') {
                   3924: 		$thisdir=$token->[2]->{'href'};
                   3925: 	    }
                   3926: 	}
                   3927:     }
                   3928:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3929:     foreach my $link (@rlinks) {
1.726     raeburn  3930: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3931: 		($link=~/^\//) ||
                   3932: 		($link=~/^javascript:/i) ||
                   3933: 		($link=~/^mailto:/i) ||
                   3934: 		($link=~/^\#/)) {
                   3935: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3936: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3937: 	}
                   3938:     }
                   3939: # -------------------------------------------------- Deal with Applet codebases
                   3940:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3941:     return $output;
                   3942: }
                   3943: 
1.112     bowersj2 3944: =pod
                   3945: 
1.648     raeburn  3946: =item * &get_student_view()
1.112     bowersj2 3947: 
                   3948: show a snapshot of what student was looking at
                   3949: 
                   3950: =cut
                   3951: 
1.10      albertel 3952: sub get_student_view {
1.186     albertel 3953:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3954:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3955:   my (%form);
1.10      albertel 3956:   my @elements=('symb','courseid','domain','username');
                   3957:   foreach my $element (@elements) {
1.186     albertel 3958:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3959:   }
1.186     albertel 3960:   if (defined($moreenv)) {
                   3961:       %form=(%form,%{$moreenv});
                   3962:   }
1.236     albertel 3963:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3964:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3965:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3966:   $userview=~s/\<body[^\>]*\>//gi;
                   3967:   $userview=~s/\<\/body\>//gi;
                   3968:   $userview=~s/\<html\>//gi;
                   3969:   $userview=~s/\<\/html\>//gi;
                   3970:   $userview=~s/\<head\>//gi;
                   3971:   $userview=~s/\<\/head\>//gi;
                   3972:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3973:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3974:   if (wantarray) {
                   3975:      return ($userview,$response);
                   3976:   } else {
                   3977:      return $userview;
                   3978:   }
                   3979: }
                   3980: 
                   3981: sub get_student_view_with_retries {
                   3982:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3983: 
                   3984:     my $ok = 0;                 # True if we got a good response.
                   3985:     my $content;
                   3986:     my $response;
                   3987: 
                   3988:     # Try to get the student_view done. within the retries count:
                   3989:     
                   3990:     do {
                   3991:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3992:          $ok      = $response->is_success;
                   3993:          if (!$ok) {
                   3994:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3995:          }
                   3996:          $retries--;
                   3997:     } while (!$ok && ($retries > 0));
                   3998:     
                   3999:     if (!$ok) {
                   4000:        $content = '';          # On error return an empty content.
                   4001:     }
1.651     www      4002:     if (wantarray) {
                   4003:        return ($content, $response);
                   4004:     } else {
                   4005:        return $content;
                   4006:     }
1.11      albertel 4007: }
                   4008: 
1.112     bowersj2 4009: =pod
                   4010: 
1.648     raeburn  4011: =item * &get_student_answers() 
1.112     bowersj2 4012: 
                   4013: show a snapshot of how student was answering problem
                   4014: 
                   4015: =cut
                   4016: 
1.11      albertel 4017: sub get_student_answers {
1.100     sakharuk 4018:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4019:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4020:   my (%moreenv);
1.11      albertel 4021:   my @elements=('symb','courseid','domain','username');
                   4022:   foreach my $element (@elements) {
1.186     albertel 4023:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4024:   }
1.186     albertel 4025:   $moreenv{'grade_target'}='answer';
                   4026:   %moreenv=(%form,%moreenv);
1.497     raeburn  4027:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4028:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4029:   return $userview;
1.1       albertel 4030: }
1.116     albertel 4031: 
                   4032: =pod
                   4033: 
                   4034: =item * &submlink()
                   4035: 
1.242     albertel 4036: Inputs: $text $uname $udom $symb $target
1.116     albertel 4037: 
                   4038: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4039: 
                   4040: =cut
                   4041: 
                   4042: ###############################################
                   4043: sub submlink {
1.242     albertel 4044:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4045:     if (!($uname && $udom)) {
                   4046: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4047: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4048: 	if (!$symb) { $symb=$cursymb; }
                   4049:     }
1.254     matthew  4050:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4051:     $symb=&escape($symb);
1.960     bisitz   4052:     if ($target) { $target=" target=\"$target\""; }
                   4053:     return
                   4054:         '<a href="/adm/grades?command=submission'.
                   4055:         '&amp;symb='.$symb.
                   4056:         '&amp;student='.$uname.
                   4057:         '&amp;userdom='.$udom.'"'.
                   4058:         $target.'>'.$text.'</a>';
1.242     albertel 4059: }
                   4060: ##############################################
                   4061: 
                   4062: =pod
                   4063: 
                   4064: =item * &pgrdlink()
                   4065: 
                   4066: Inputs: $text $uname $udom $symb $target
                   4067: 
                   4068: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4069: 
                   4070: =cut
                   4071: 
                   4072: ###############################################
                   4073: sub pgrdlink {
                   4074:     my $link=&submlink(@_);
                   4075:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4076:     return $link;
                   4077: }
                   4078: ##############################################
                   4079: 
                   4080: =pod
                   4081: 
                   4082: =item * &pprmlink()
                   4083: 
                   4084: Inputs: $text $uname $udom $symb $target
                   4085: 
                   4086: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4087: student and a specific resource
1.242     albertel 4088: 
                   4089: =cut
                   4090: 
                   4091: ###############################################
                   4092: sub pprmlink {
                   4093:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4094:     if (!($uname && $udom)) {
                   4095: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4096: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4097: 	if (!$symb) { $symb=$cursymb; }
                   4098:     }
1.254     matthew  4099:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4100:     $symb=&escape($symb);
1.242     albertel 4101:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4102:     return '<a href="/adm/parmset?command=set&amp;'.
                   4103: 	'symb='.$symb.'&amp;uname='.$uname.
                   4104: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4105: }
                   4106: ##############################################
1.37      matthew  4107: 
1.112     bowersj2 4108: =pod
                   4109: 
                   4110: =back
                   4111: 
                   4112: =cut
                   4113: 
1.37      matthew  4114: ###############################################
1.51      www      4115: 
                   4116: 
                   4117: sub timehash {
1.687     raeburn  4118:     my ($thistime) = @_;
                   4119:     my $timezone = &Apache::lonlocal::gettimezone();
                   4120:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4121:                      ->set_time_zone($timezone);
                   4122:     my $wday = $dt->day_of_week();
                   4123:     if ($wday == 7) { $wday = 0; }
                   4124:     return ( 'second' => $dt->second(),
                   4125:              'minute' => $dt->minute(),
                   4126:              'hour'   => $dt->hour(),
                   4127:              'day'     => $dt->day_of_month(),
                   4128:              'month'   => $dt->month(),
                   4129:              'year'    => $dt->year(),
                   4130:              'weekday' => $wday,
                   4131:              'dayyear' => $dt->day_of_year(),
                   4132:              'dlsav'   => $dt->is_dst() );
1.51      www      4133: }
                   4134: 
1.370     www      4135: sub utc_string {
                   4136:     my ($date)=@_;
1.371     www      4137:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4138: }
                   4139: 
1.51      www      4140: sub maketime {
                   4141:     my %th=@_;
1.687     raeburn  4142:     my ($epoch_time,$timezone,$dt);
                   4143:     $timezone = &Apache::lonlocal::gettimezone();
                   4144:     eval {
                   4145:         $dt = DateTime->new( year   => $th{'year'},
                   4146:                              month  => $th{'month'},
                   4147:                              day    => $th{'day'},
                   4148:                              hour   => $th{'hour'},
                   4149:                              minute => $th{'minute'},
                   4150:                              second => $th{'second'},
                   4151:                              time_zone => $timezone,
                   4152:                          );
                   4153:     };
                   4154:     if (!$@) {
                   4155:         $epoch_time = $dt->epoch;
                   4156:         if ($epoch_time) {
                   4157:             return $epoch_time;
                   4158:         }
                   4159:     }
1.51      www      4160:     return POSIX::mktime(
                   4161:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4162:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4163: }
                   4164: 
                   4165: #########################################
1.51      www      4166: 
                   4167: sub findallcourses {
1.482     raeburn  4168:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4169:     my %roles;
                   4170:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4171:     my %courses;
1.51      www      4172:     my $now=time;
1.482     raeburn  4173:     if (!defined($uname)) {
                   4174:         $uname = $env{'user.name'};
                   4175:     }
                   4176:     if (!defined($udom)) {
                   4177:         $udom = $env{'user.domain'};
                   4178:     }
                   4179:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4180:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4181:         if (!%roles) {
                   4182:             %roles = (
                   4183:                        cc => 1,
1.907     raeburn  4184:                        co => 1,
1.482     raeburn  4185:                        in => 1,
                   4186:                        ep => 1,
                   4187:                        ta => 1,
                   4188:                        cr => 1,
                   4189:                        st => 1,
                   4190:              );
                   4191:         }
                   4192:         foreach my $entry (keys(%roleshash)) {
                   4193:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4194:             if ($trole =~ /^cr/) { 
                   4195:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4196:             } else {
                   4197:                 next if (!exists($roles{$trole}));
                   4198:             }
                   4199:             if ($tend) {
                   4200:                 next if ($tend < $now);
                   4201:             }
                   4202:             if ($tstart) {
                   4203:                 next if ($tstart > $now);
                   4204:             }
1.1058    raeburn  4205:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4206:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4207:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4208:             if ($secpart eq '') {
                   4209:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4210:                 $sec = 'none';
1.1058    raeburn  4211:                 $value .= $cnum.'/';
1.482     raeburn  4212:             } else {
                   4213:                 $cnum = $cnumpart;
                   4214:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4215:                 $value .= $cnum.'/'.$sec;
                   4216:             }
                   4217:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4218:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4219:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4220:                 }
                   4221:             } else {
                   4222:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4223:             }
1.482     raeburn  4224:         }
                   4225:     } else {
                   4226:         foreach my $key (keys(%env)) {
1.483     albertel 4227: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4228:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4229: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4230: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4231: 	        next if (%roles && !exists($roles{$role}));
                   4232: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4233:                 my $active=1;
                   4234:                 if ($starttime) {
                   4235: 		    if ($now<$starttime) { $active=0; }
                   4236:                 }
                   4237:                 if ($endtime) {
                   4238:                     if ($now>$endtime) { $active=0; }
                   4239:                 }
                   4240:                 if ($active) {
1.1058    raeburn  4241:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4242:                     if ($sec eq '') {
                   4243:                         $sec = 'none';
1.1058    raeburn  4244:                     } else {
                   4245:                         $value .= $sec;
                   4246:                     }
                   4247:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4248:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4249:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4250:                         }
                   4251:                     } else {
                   4252:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4253:                     }
1.474     raeburn  4254:                 }
                   4255:             }
1.51      www      4256:         }
                   4257:     }
1.474     raeburn  4258:     return %courses;
1.51      www      4259: }
1.37      matthew  4260: 
1.54      www      4261: ###############################################
1.474     raeburn  4262: 
                   4263: sub blockcheck {
1.1062    raeburn  4264:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4265: 
                   4266:     if (!defined($udom)) {
                   4267:         $udom = $env{'user.domain'};
                   4268:     }
                   4269:     if (!defined($uname)) {
                   4270:         $uname = $env{'user.name'};
                   4271:     }
                   4272: 
                   4273:     # If uname and udom are for a course, check for blocks in the course.
                   4274: 
                   4275:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4276:         my ($startblock,$endblock,$triggerblock) = 
                   4277:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4278:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4279:     }
1.474     raeburn  4280: 
1.502     raeburn  4281:     my $startblock = 0;
                   4282:     my $endblock = 0;
1.1062    raeburn  4283:     my $triggerblock = '';
1.482     raeburn  4284:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4285: 
1.490     raeburn  4286:     # If uname is for a user, and activity is course-specific, i.e.,
                   4287:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4288: 
1.490     raeburn  4289:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4290:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4291:         foreach my $key (keys(%live_courses)) {
                   4292:             if ($key ne $env{'request.course.id'}) {
                   4293:                 delete($live_courses{$key});
                   4294:             }
                   4295:         }
                   4296:     }
                   4297: 
                   4298:     my $otheruser = 0;
                   4299:     my %own_courses;
                   4300:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4301:         # Resource belongs to user other than current user.
                   4302:         $otheruser = 1;
                   4303:         # Gather courses for current user
                   4304:         %own_courses = 
                   4305:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4306:     }
                   4307: 
                   4308:     # Gather active course roles - course coordinator, instructor, 
                   4309:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4310: 
                   4311:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4312:         my ($cdom,$cnum);
                   4313:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4314:             $cdom = $env{'course.'.$course.'.domain'};
                   4315:             $cnum = $env{'course.'.$course.'.num'};
                   4316:         } else {
1.490     raeburn  4317:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4318:         }
                   4319:         my $no_ownblock = 0;
                   4320:         my $no_userblock = 0;
1.533     raeburn  4321:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4322:             # Check if current user has 'evb' priv for this
                   4323:             if (defined($own_courses{$course})) {
                   4324:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4325:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4326:                     if ($sec ne 'none') {
                   4327:                         $checkrole .= '/'.$sec;
                   4328:                     }
                   4329:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4330:                         $no_ownblock = 1;
                   4331:                         last;
                   4332:                     }
                   4333:                 }
                   4334:             }
                   4335:             # if they have 'evb' priv and are currently not playing student
                   4336:             next if (($no_ownblock) &&
                   4337:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4338:         }
1.474     raeburn  4339:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4340:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4341:             if ($sec ne 'none') {
1.482     raeburn  4342:                 $checkrole .= '/'.$sec;
1.474     raeburn  4343:             }
1.490     raeburn  4344:             if ($otheruser) {
                   4345:                 # Resource belongs to user other than current user.
                   4346:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4347:                 my (%allroles,%userroles);
                   4348:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4349:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4350:                         my ($trole,$tdom,$tnum,$tsec);
                   4351:                         if ($entry =~ /^cr/) {
                   4352:                             ($trole,$tdom,$tnum,$tsec) = 
                   4353:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4354:                         } else {
                   4355:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4356:                         }
                   4357:                         my ($spec,$area,$trest);
                   4358:                         $area = '/'.$tdom.'/'.$tnum;
                   4359:                         $trest = $tnum;
                   4360:                         if ($tsec ne '') {
                   4361:                             $area .= '/'.$tsec;
                   4362:                             $trest .= '/'.$tsec;
                   4363:                         }
                   4364:                         $spec = $trole.'.'.$area;
                   4365:                         if ($trole =~ /^cr/) {
                   4366:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4367:                                                               $tdom,$spec,$trest,$area);
                   4368:                         } else {
                   4369:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4370:                                                                 $tdom,$spec,$trest,$area);
                   4371:                         }
                   4372:                     }
                   4373:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4374:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4375:                         if ($1) {
                   4376:                             $no_userblock = 1;
                   4377:                             last;
                   4378:                         }
1.486     raeburn  4379:                     }
                   4380:                 }
1.490     raeburn  4381:             } else {
                   4382:                 # Resource belongs to current user
                   4383:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4384:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4385:                     $no_ownblock = 1;
                   4386:                     last;
                   4387:                 }
1.474     raeburn  4388:             }
                   4389:         }
                   4390:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4391:         next if (($no_ownblock) &&
1.491     albertel 4392:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4393:         next if ($no_userblock);
1.474     raeburn  4394: 
1.866     kalberla 4395:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4396:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4397:         
1.1062    raeburn  4398:         my ($start,$end,$trigger) = 
                   4399:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4400:         if (($start != 0) && 
                   4401:             (($startblock == 0) || ($startblock > $start))) {
                   4402:             $startblock = $start;
1.1062    raeburn  4403:             if ($trigger ne '') {
                   4404:                 $triggerblock = $trigger;
                   4405:             }
1.502     raeburn  4406:         }
                   4407:         if (($end != 0)  &&
                   4408:             (($endblock == 0) || ($endblock < $end))) {
                   4409:             $endblock = $end;
1.1062    raeburn  4410:             if ($trigger ne '') {
                   4411:                 $triggerblock = $trigger;
                   4412:             }
1.502     raeburn  4413:         }
1.490     raeburn  4414:     }
1.1062    raeburn  4415:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4416: }
                   4417: 
                   4418: sub get_blocks {
1.1062    raeburn  4419:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4420:     my $startblock = 0;
                   4421:     my $endblock = 0;
1.1062    raeburn  4422:     my $triggerblock = '';
1.490     raeburn  4423:     my $course = $cdom.'_'.$cnum;
                   4424:     $setters->{$course} = {};
                   4425:     $setters->{$course}{'staff'} = [];
                   4426:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4427:     $setters->{$course}{'triggers'} = [];
                   4428:     my (@blockers,%triggered);
                   4429:     my $now = time;
                   4430:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4431:     if ($activity eq 'docs') {
                   4432:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4433:         foreach my $block (@blockers) {
                   4434:             if ($block =~ /^firstaccess____(.+)$/) {
                   4435:                 my $item = $1;
                   4436:                 my $type = 'map';
                   4437:                 my $timersymb = $item;
                   4438:                 if ($item eq 'course') {
                   4439:                     $type = 'course';
                   4440:                 } elsif ($item =~ /___\d+___/) {
                   4441:                     $type = 'resource';
                   4442:                 } else {
                   4443:                     $timersymb = &Apache::lonnet::symbread($item);
                   4444:                 }
                   4445:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4446:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4447:                 $triggered{$block} = {
                   4448:                                        start => $start,
                   4449:                                        end   => $end,
                   4450:                                        type  => $type,
                   4451:                                      };
                   4452:             }
                   4453:         }
                   4454:     } else {
                   4455:         foreach my $block (keys(%commblocks)) {
                   4456:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4457:                 my ($start,$end) = ($1,$2);
                   4458:                 if ($start <= time && $end >= time) {
                   4459:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4460:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4461:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4462:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4463:                                     push(@blockers,$block);
                   4464:                                 }
                   4465:                             }
                   4466:                         }
                   4467:                     }
                   4468:                 }
                   4469:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4470:                 my $item = $1;
                   4471:                 my $timersymb = $item; 
                   4472:                 my $type = 'map';
                   4473:                 if ($item eq 'course') {
                   4474:                     $type = 'course';
                   4475:                 } elsif ($item =~ /___\d+___/) {
                   4476:                     $type = 'resource';
                   4477:                 } else {
                   4478:                     $timersymb = &Apache::lonnet::symbread($item);
                   4479:                 }
                   4480:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4481:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4482:                 if ($start && $end) {
                   4483:                     if (($start <= time) && ($end >= time)) {
                   4484:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4485:                             push(@blockers,$block);
                   4486:                             $triggered{$block} = {
                   4487:                                                    start => $start,
                   4488:                                                    end   => $end,
                   4489:                                                    type  => $type,
                   4490:                                                  };
                   4491:                         }
                   4492:                     }
1.490     raeburn  4493:                 }
1.1062    raeburn  4494:             }
                   4495:         }
                   4496:     }
                   4497:     foreach my $blocker (@blockers) {
                   4498:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4499:             &parse_block_record($commblocks{$blocker});
                   4500:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4501:         my ($start,$end,$triggertype);
                   4502:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4503:             ($start,$end) = ($1,$2);
                   4504:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4505:             $start = $triggered{$blocker}{'start'};
                   4506:             $end = $triggered{$blocker}{'end'};
                   4507:             $triggertype = $triggered{$blocker}{'type'};
                   4508:         }
                   4509:         if ($start) {
                   4510:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4511:             if ($triggertype) {
                   4512:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4513:             } else {
                   4514:                 push(@{$$setters{$course}{'triggers'}},0);
                   4515:             }
                   4516:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4517:                 $startblock = $start;
                   4518:                 if ($triggertype) {
                   4519:                     $triggerblock = $blocker;
1.474     raeburn  4520:                 }
                   4521:             }
1.1062    raeburn  4522:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4523:                $endblock = $end;
                   4524:                if ($triggertype) {
                   4525:                    $triggerblock = $blocker;
                   4526:                }
                   4527:             }
1.474     raeburn  4528:         }
                   4529:     }
1.1062    raeburn  4530:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4531: }
                   4532: 
                   4533: sub parse_block_record {
                   4534:     my ($record) = @_;
                   4535:     my ($setuname,$setudom,$title,$blocks);
                   4536:     if (ref($record) eq 'HASH') {
                   4537:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4538:         $title = &unescape($record->{'event'});
                   4539:         $blocks = $record->{'blocks'};
                   4540:     } else {
                   4541:         my @data = split(/:/,$record,3);
                   4542:         if (scalar(@data) eq 2) {
                   4543:             $title = $data[1];
                   4544:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4545:         } else {
                   4546:             ($setuname,$setudom,$title) = @data;
                   4547:         }
                   4548:         $blocks = { 'com' => 'on' };
                   4549:     }
                   4550:     return ($setuname,$setudom,$title,$blocks);
                   4551: }
                   4552: 
1.854     kalberla 4553: sub blocking_status {
1.1062    raeburn  4554:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4555:     my %setters;
1.890     droeschl 4556: 
1.1061    raeburn  4557: # check for active blocking
1.1062    raeburn  4558:     my ($startblock,$endblock,$triggerblock) = 
                   4559:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4560:     my $blocked = 0;
                   4561:     if ($startblock && $endblock) {
                   4562:         $blocked = 1;
                   4563:     }
1.890     droeschl 4564: 
1.1061    raeburn  4565: # caller just wants to know whether a block is active
                   4566:     if (!wantarray) { return $blocked; }
                   4567: 
                   4568: # build a link to a popup window containing the details
                   4569:     my $querystring  = "?activity=$activity";
                   4570: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4571:     if ($activity eq 'port') {
                   4572:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4573:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4574:     } elsif ($activity eq 'docs') {
                   4575:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4576:     }
1.1061    raeburn  4577: 
                   4578:     my $output .= <<'END_MYBLOCK';
                   4579: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4580:     var options = "width=" + w + ",height=" + h + ",";
                   4581:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4582:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4583:     var newWin = window.open(url, wdwName, options);
                   4584:     newWin.focus();
                   4585: }
1.890     droeschl 4586: END_MYBLOCK
1.854     kalberla 4587: 
1.1061    raeburn  4588:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4589:   
1.1061    raeburn  4590:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4591:     my $text = &mt('Communication Blocked');
                   4592:     if ($activity eq 'docs') {
                   4593:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4594:     } elsif ($activity eq 'printout') {
                   4595:         $text = &mt('Printing Blocked');
1.1062    raeburn  4596:     }
1.1061    raeburn  4597:     $output .= <<"END_BLOCK";
1.867     kalberla 4598: <div class='LC_comblock'>
1.869     kalberla 4599:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4600:   title='$text'>
                   4601:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4602:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4603:   title='$text'>$text</a>
1.867     kalberla 4604: </div>
                   4605: 
                   4606: END_BLOCK
1.474     raeburn  4607: 
1.1061    raeburn  4608:     return ($blocked, $output);
1.854     kalberla 4609: }
1.490     raeburn  4610: 
1.60      matthew  4611: ###############################################
                   4612: 
1.682     raeburn  4613: sub check_ip_acc {
                   4614:     my ($acc)=@_;
                   4615:     &Apache::lonxml::debug("acc is $acc");
                   4616:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4617:         return 1;
                   4618:     }
                   4619:     my $allowed=0;
                   4620:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4621: 
                   4622:     my $name;
                   4623:     foreach my $pattern (split(',',$acc)) {
                   4624:         $pattern =~ s/^\s*//;
                   4625:         $pattern =~ s/\s*$//;
                   4626:         if ($pattern =~ /\*$/) {
                   4627:             #35.8.*
                   4628:             $pattern=~s/\*//;
                   4629:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4630:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4631:             #35.8.3.[34-56]
                   4632:             my $low=$2;
                   4633:             my $high=$3;
                   4634:             $pattern=$1;
                   4635:             if ($ip =~ /^\Q$pattern\E/) {
                   4636:                 my $last=(split(/\./,$ip))[3];
                   4637:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4638:             }
                   4639:         } elsif ($pattern =~ /^\*/) {
                   4640:             #*.msu.edu
                   4641:             $pattern=~s/\*//;
                   4642:             if (!defined($name)) {
                   4643:                 use Socket;
                   4644:                 my $netaddr=inet_aton($ip);
                   4645:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4646:             }
                   4647:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4648:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4649:             #127.0.0.1
                   4650:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4651:         } else {
                   4652:             #some.name.com
                   4653:             if (!defined($name)) {
                   4654:                 use Socket;
                   4655:                 my $netaddr=inet_aton($ip);
                   4656:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4657:             }
                   4658:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4659:         }
                   4660:         if ($allowed) { last; }
                   4661:     }
                   4662:     return $allowed;
                   4663: }
                   4664: 
                   4665: ###############################################
                   4666: 
1.60      matthew  4667: =pod
                   4668: 
1.112     bowersj2 4669: =head1 Domain Template Functions
                   4670: 
                   4671: =over 4
                   4672: 
                   4673: =item * &determinedomain()
1.60      matthew  4674: 
                   4675: Inputs: $domain (usually will be undef)
                   4676: 
1.63      www      4677: Returns: Determines which domain should be used for designs
1.60      matthew  4678: 
                   4679: =cut
1.54      www      4680: 
1.60      matthew  4681: ###############################################
1.63      www      4682: sub determinedomain {
                   4683:     my $domain=shift;
1.531     albertel 4684:     if (! $domain) {
1.60      matthew  4685:         # Determine domain if we have not been given one
1.893     raeburn  4686:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4687:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4688:         if ($env{'request.role.domain'}) { 
                   4689:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4690:         }
                   4691:     }
1.63      www      4692:     return $domain;
                   4693: }
                   4694: ###############################################
1.517     raeburn  4695: 
1.518     albertel 4696: sub devalidate_domconfig_cache {
                   4697:     my ($udom)=@_;
                   4698:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4699: }
                   4700: 
                   4701: # ---------------------- Get domain configuration for a domain
                   4702: sub get_domainconf {
                   4703:     my ($udom) = @_;
                   4704:     my $cachetime=1800;
                   4705:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4706:     if (defined($cached)) { return %{$result}; }
                   4707: 
                   4708:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4709: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4710:     my (%designhash,%legacy);
1.518     albertel 4711:     if (keys(%domconfig) > 0) {
                   4712:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4713:             if (keys(%{$domconfig{'login'}})) {
                   4714:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4715:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4716:                         if ($key eq 'loginvia') {
                   4717:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4718:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4719:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4720:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4721:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4722:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4723:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4724: 
                   4725:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4726:                                             } else {
1.1013    raeburn  4727:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4728:                                             }
                   4729:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4730:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4731:                                             }
1.946     raeburn  4732:                                         }
                   4733:                                     }
                   4734:                                 }
                   4735:                             }
                   4736:                         } else {
                   4737:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4738:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4739:                                     $domconfig{'login'}{$key}{$img};
                   4740:                             }
1.699     raeburn  4741:                         }
                   4742:                     } else {
                   4743:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4744:                     }
1.632     raeburn  4745:                 }
                   4746:             } else {
                   4747:                 $legacy{'login'} = 1;
1.518     albertel 4748:             }
1.632     raeburn  4749:         } else {
                   4750:             $legacy{'login'} = 1;
1.518     albertel 4751:         }
                   4752:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4753:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4754:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4755:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4756:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4757:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4758:                         }
1.518     albertel 4759:                     }
                   4760:                 }
1.632     raeburn  4761:             } else {
                   4762:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4763:             }
1.632     raeburn  4764:         } else {
                   4765:             $legacy{'rolecolors'} = 1;
1.518     albertel 4766:         }
1.948     raeburn  4767:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4768:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4769:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4770:             }
                   4771:         }
1.632     raeburn  4772:         if (keys(%legacy) > 0) {
                   4773:             my %legacyhash = &get_legacy_domconf($udom);
                   4774:             foreach my $item (keys(%legacyhash)) {
                   4775:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4776:                     if ($legacy{'login'}) { 
                   4777:                         $designhash{$item} = $legacyhash{$item};
                   4778:                     }
                   4779:                 } else {
                   4780:                     if ($legacy{'rolecolors'}) {
                   4781:                         $designhash{$item} = $legacyhash{$item};
                   4782:                     }
1.518     albertel 4783:                 }
                   4784:             }
                   4785:         }
1.632     raeburn  4786:     } else {
                   4787:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4788:     }
                   4789:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4790: 				  $cachetime);
                   4791:     return %designhash;
                   4792: }
                   4793: 
1.632     raeburn  4794: sub get_legacy_domconf {
                   4795:     my ($udom) = @_;
                   4796:     my %legacyhash;
                   4797:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4798:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4799:     if (-e $designfile) {
                   4800:         if ( open (my $fh,"<$designfile") ) {
                   4801:             while (my $line = <$fh>) {
                   4802:                 next if ($line =~ /^\#/);
                   4803:                 chomp($line);
                   4804:                 my ($key,$val)=(split(/\=/,$line));
                   4805:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4806:             }
                   4807:             close($fh);
                   4808:         }
                   4809:     }
1.1026    raeburn  4810:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4811:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4812:     }
                   4813:     return %legacyhash;
                   4814: }
                   4815: 
1.63      www      4816: =pod
                   4817: 
1.112     bowersj2 4818: =item * &domainlogo()
1.63      www      4819: 
                   4820: Inputs: $domain (usually will be undef)
                   4821: 
                   4822: Returns: A link to a domain logo, if the domain logo exists.
                   4823: If the domain logo does not exist, a description of the domain.
                   4824: 
                   4825: =cut
1.112     bowersj2 4826: 
1.63      www      4827: ###############################################
                   4828: sub domainlogo {
1.517     raeburn  4829:     my $domain = &determinedomain(shift);
1.518     albertel 4830:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4831:     # See if there is a logo
                   4832:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4833:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4834:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4835: 	    if ($imgsrc =~ m{^/res/}) {
                   4836: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4837: 		&Apache::lonnet::repcopy($local_name);
                   4838: 	    }
                   4839: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4840:         } 
                   4841:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4842:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4843:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4844:     } else {
1.60      matthew  4845:         return '';
1.59      www      4846:     }
                   4847: }
1.63      www      4848: ##############################################
                   4849: 
                   4850: =pod
                   4851: 
1.112     bowersj2 4852: =item * &designparm()
1.63      www      4853: 
                   4854: Inputs: $which parameter; $domain (usually will be undef)
                   4855: 
                   4856: Returns: value of designparamter $which
                   4857: 
                   4858: =cut
1.112     bowersj2 4859: 
1.397     albertel 4860: 
1.400     albertel 4861: ##############################################
1.397     albertel 4862: sub designparm {
                   4863:     my ($which,$domain)=@_;
                   4864:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4865:         return $env{'environment.color.'.$which};
1.96      www      4866:     }
1.63      www      4867:     $domain=&determinedomain($domain);
1.1016    raeburn  4868:     my %domdesign;
                   4869:     unless ($domain eq 'public') {
                   4870:         %domdesign = &get_domainconf($domain);
                   4871:     }
1.520     raeburn  4872:     my $output;
1.517     raeburn  4873:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4874:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4875:     } else {
1.520     raeburn  4876:         $output = $defaultdesign{$which};
                   4877:     }
                   4878:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4879:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4880:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4881:             if ($output =~ m{^/res/}) {
                   4882:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4883:                 &Apache::lonnet::repcopy($local_name);
                   4884:             }
1.520     raeburn  4885:             $output = &lonhttpdurl($output);
                   4886:         }
1.63      www      4887:     }
1.520     raeburn  4888:     return $output;
1.63      www      4889: }
1.59      www      4890: 
1.822     bisitz   4891: ##############################################
                   4892: =pod
                   4893: 
1.832     bisitz   4894: =item * &authorspace()
                   4895: 
1.1028    raeburn  4896: Inputs: $url (usually will be undef).
1.832     bisitz   4897: 
1.1028    raeburn  4898: Returns: Path to Construction Space containing the resource or 
                   4899:          directory being viewed (or for which action is being taken). 
                   4900:          If $url is provided, and begins /priv/<domain>/<uname>
                   4901:          the path will be that portion of the $context argument.
                   4902:          Otherwise the path will be for the author space of the current
                   4903:          user when the current role is author, or for that of the 
                   4904:          co-author/assistant co-author space when the current role 
                   4905:          is co-author or assistant co-author.
1.832     bisitz   4906: 
                   4907: =cut
                   4908: 
                   4909: sub authorspace {
1.1028    raeburn  4910:     my ($url) = @_;
                   4911:     if ($url ne '') {
                   4912:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4913:            return $1;
                   4914:         }
                   4915:     }
1.832     bisitz   4916:     my $caname = '';
1.1024    www      4917:     my $cadom = '';
1.1028    raeburn  4918:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4919:         ($cadom,$caname) =
1.832     bisitz   4920:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4921:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4922:         $caname = $env{'user.name'};
1.1024    www      4923:         $cadom = $env{'user.domain'};
1.832     bisitz   4924:     }
1.1028    raeburn  4925:     if (($caname ne '') && ($cadom ne '')) {
                   4926:         return "/priv/$cadom/$caname/";
                   4927:     }
                   4928:     return;
1.832     bisitz   4929: }
                   4930: 
                   4931: ##############################################
                   4932: =pod
                   4933: 
1.822     bisitz   4934: =item * &head_subbox()
                   4935: 
                   4936: Inputs: $content (contains HTML code with page functions, etc.)
                   4937: 
                   4938: Returns: HTML div with $content
                   4939:          To be included in page header
                   4940: 
                   4941: =cut
                   4942: 
                   4943: sub head_subbox {
                   4944:     my ($content)=@_;
                   4945:     my $output =
1.993     raeburn  4946:         '<div class="LC_head_subbox">'
1.822     bisitz   4947:        .$content
                   4948:        .'</div>'
                   4949: }
                   4950: 
                   4951: ##############################################
                   4952: =pod
                   4953: 
                   4954: =item * &CSTR_pageheader()
                   4955: 
1.1026    raeburn  4956: Input: (optional) filename from which breadcrumb trail is built.
                   4957:        In most cases no input as needed, as $env{'request.filename'}
                   4958:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4959: 
                   4960: Returns: HTML div with CSTR path and recent box
                   4961:          To be included on Construction Space pages
                   4962: 
                   4963: =cut
                   4964: 
                   4965: sub CSTR_pageheader {
1.1026    raeburn  4966:     my ($trailfile) = @_;
                   4967:     if ($trailfile eq '') {
                   4968:         $trailfile = $env{'request.filename'};
                   4969:     }
                   4970: 
                   4971: # this is for resources; directories have customtitle, and crumbs
                   4972: # and select recent are created in lonpubdir.pm
                   4973: 
                   4974:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4975:     my ($udom,$uname,$thisdisfn)=
1.1026    raeburn  4976:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
                   4977:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4978:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4979: 
                   4980:     my $parentpath = '';
                   4981:     my $lastitem = '';
                   4982:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4983:         $parentpath = $1;
                   4984:         $lastitem = $2;
                   4985:     } else {
                   4986:         $lastitem = $thisdisfn;
                   4987:     }
1.921     bisitz   4988: 
                   4989:     my $output =
1.822     bisitz   4990:          '<div>'
                   4991:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4992:         .'<b>'.&mt('Construction Space:').'</b> '
                   4993:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4994:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4995:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4996: 
                   4997:     if ($lastitem) {
                   4998:         $output .=
                   4999:              '<span class="LC_filename">'
                   5000:             .$lastitem
                   5001:             .'</span>';
                   5002:     }
                   5003:     $output .=
                   5004:          '<br />'
1.822     bisitz   5005:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5006:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5007:         .'</form>'
                   5008:         .&Apache::lonmenu::constspaceform()
                   5009:         .'</div>';
1.921     bisitz   5010: 
                   5011:     return $output;
1.822     bisitz   5012: }
                   5013: 
1.60      matthew  5014: ###############################################
                   5015: ###############################################
                   5016: 
                   5017: =pod
                   5018: 
1.112     bowersj2 5019: =back
                   5020: 
1.549     albertel 5021: =head1 HTML Helpers
1.112     bowersj2 5022: 
                   5023: =over 4
                   5024: 
                   5025: =item * &bodytag()
1.60      matthew  5026: 
                   5027: Returns a uniform header for LON-CAPA web pages.
                   5028: 
                   5029: Inputs: 
                   5030: 
1.112     bowersj2 5031: =over 4
                   5032: 
                   5033: =item * $title, A title to be displayed on the page.
                   5034: 
                   5035: =item * $function, the current role (can be undef).
                   5036: 
                   5037: =item * $addentries, extra parameters for the <body> tag.
                   5038: 
                   5039: =item * $bodyonly, if defined, only return the <body> tag.
                   5040: 
                   5041: =item * $domain, if defined, force a given domain.
                   5042: 
                   5043: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5044:             text interface only)
1.60      matthew  5045: 
1.814     bisitz   5046: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5047:                      navigational links
1.317     albertel 5048: 
1.338     albertel 5049: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5050: 
1.460     albertel 5051: =item * $args, optional argument valid values are
                   5052:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5053:             inherit_jsmath -> when creating popup window in a page,
                   5054:                               should it have jsmath forced on by the
                   5055:                               current page
1.460     albertel 5056: 
1.112     bowersj2 5057: =back
                   5058: 
1.60      matthew  5059: Returns: A uniform header for LON-CAPA web pages.  
                   5060: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5061: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5062: other decorations will be returned.
                   5063: 
                   5064: =cut
                   5065: 
1.54      www      5066: sub bodytag {
1.831     bisitz   5067:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.962     droeschl 5068:         $no_nav_bar,$bgcolor,$args)=@_;
1.339     albertel 5069: 
1.954     raeburn  5070:     my $public;
                   5071:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5072:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5073:         $public = 1;
                   5074:     }
1.460     albertel 5075:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 5076: 
1.183     matthew  5077:     $function = &get_users_function() if (!$function);
1.339     albertel 5078:     my $img =    &designparm($function.'.img',$domain);
                   5079:     my $font =   &designparm($function.'.font',$domain);
                   5080:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5081: 
1.803     bisitz   5082:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5083: 		   'bgcolor' => $pgbg,
1.339     albertel 5084: 		   'text'    => $font,
                   5085:                    'alink'   => &designparm($function.'.alink',$domain),
                   5086: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5087: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5088:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5089: 
1.63      www      5090:  # role and realm
1.378     raeburn  5091:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5092:     if ($role  eq 'ca') {
1.479     albertel 5093:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5094:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5095:     } 
1.55      www      5096: # realm
1.258     albertel 5097:     if ($env{'request.course.id'}) {
1.378     raeburn  5098:         if ($env{'request.role'} !~ /^cr/) {
                   5099:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5100:         }
1.898     raeburn  5101:         if ($env{'request.course.sec'}) {
                   5102:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5103:         }   
1.359     albertel 5104: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5105:     } else {
                   5106:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5107:     }
1.433     albertel 5108: 
1.359     albertel 5109:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5110: 
1.438     albertel 5111:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5112: 
1.101     www      5113: # construct main body tag
1.359     albertel 5114:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5115: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5116: 
1.530     albertel 5117:     if ($bodyonly) {
1.60      matthew  5118:         return $bodytag;
1.798     tempelho 5119:     } 
1.359     albertel 5120: 
1.410     albertel 5121:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  5122:     if ($public) {
1.433     albertel 5123: 	undef($role);
1.434     albertel 5124:     } else {
1.1070    raeburn  5125: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5126:                                 undef,'LC_menubuttons_link');
1.433     albertel 5127:     }
1.359     albertel 5128:     
1.762     bisitz   5129:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5130:     #
                   5131:     # Extra info if you are the DC
                   5132:     my $dc_info = '';
                   5133:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5134:                         $env{'course.'.$env{'request.course.id'}.
                   5135:                                  '.domain'}.'/'})) {
                   5136:         my $cid = $env{'request.course.id'};
1.917     raeburn  5137:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5138:         $dc_info =~ s/\s+$//;
1.359     albertel 5139:     }
                   5140: 
1.898     raeburn  5141:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5142:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5143: 
1.916     droeschl 5144:         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   5145:             return $bodytag; 
                   5146:         } 
1.903     droeschl 5147: 
                   5148:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5149: 
                   5150:         #    if ($env{'request.state'} eq 'construct') {
                   5151:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5152:         #    }
                   5153: 
1.359     albertel 5154: 
                   5155: 
1.916     droeschl 5156:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5157:              if ($dc_info) {
                   5158:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5159:              }
1.916     droeschl 5160:              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   5161:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5162:             return $bodytag;
                   5163:         }
1.894     droeschl 5164: 
1.927     raeburn  5165:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   5166:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   5167:         }
1.916     droeschl 5168: 
1.903     droeschl 5169:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5170:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   5171: 
1.903     droeschl 5172:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 5173: 
1.917     raeburn  5174:         if ($dc_info) {
                   5175:             $dc_info = &dc_courseid_toggle($dc_info);
                   5176:         }
                   5177:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5178: 
1.903     droeschl 5179:         #don't show menus for public users
1.954     raeburn  5180:         if (!$public){
1.903     droeschl 5181:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5182:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5183:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5184:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5185:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5186:                                 $args->{'bread_crumbs'});
                   5187:             } elsif ($forcereg) { 
                   5188:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
                   5189:             }
1.903     droeschl 5190:         }else{
                   5191:             # this is to seperate menu from content when there's no secondary
                   5192:             # menu. Especially needed for public accessible ressources.
                   5193:             $bodytag .= '<hr style="clear:both" />';
                   5194:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5195:         }
1.903     droeschl 5196: 
1.235     raeburn  5197:         return $bodytag;
1.182     matthew  5198: }
                   5199: 
1.917     raeburn  5200: sub dc_courseid_toggle {
                   5201:     my ($dc_info) = @_;
1.980     raeburn  5202:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5203:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5204:            &mt('(More ...)').'</a></span>'.
                   5205:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5206: }
                   5207: 
1.330     albertel 5208: sub make_attr_string {
                   5209:     my ($register,$attr_ref) = @_;
                   5210: 
                   5211:     if ($attr_ref && !ref($attr_ref)) {
                   5212: 	die("addentries Must be a hash ref ".
                   5213: 	    join(':',caller(1))." ".
                   5214: 	    join(':',caller(0))." ");
                   5215:     }
                   5216: 
                   5217:     if ($register) {
1.339     albertel 5218: 	my ($on_load,$on_unload);
                   5219: 	foreach my $key (keys(%{$attr_ref})) {
                   5220: 	    if      (lc($key) eq 'onload') {
                   5221: 		$on_load.=$attr_ref->{$key}.';';
                   5222: 		delete($attr_ref->{$key});
                   5223: 
                   5224: 	    } elsif (lc($key) eq 'onunload') {
                   5225: 		$on_unload.=$attr_ref->{$key}.';';
                   5226: 		delete($attr_ref->{$key});
                   5227: 	    }
                   5228: 	}
1.953     droeschl 5229: 	$attr_ref->{'onload'}  = $on_load;
                   5230: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5231:     }
1.339     albertel 5232: 
1.330     albertel 5233:     my $attr_string;
                   5234:     foreach my $attr (keys(%$attr_ref)) {
                   5235: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5236:     }
                   5237:     return $attr_string;
                   5238: }
                   5239: 
                   5240: 
1.182     matthew  5241: ###############################################
1.251     albertel 5242: ###############################################
                   5243: 
                   5244: =pod
                   5245: 
                   5246: =item * &endbodytag()
                   5247: 
                   5248: Returns a uniform footer for LON-CAPA web pages.
                   5249: 
1.635     raeburn  5250: Inputs: 1 - optional reference to an args hash
                   5251: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5252: a 'Continue' link is not displayed if the page contains an
                   5253: internal redirect in the <head></head> section,
                   5254: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5255: 
                   5256: =cut
                   5257: 
                   5258: sub endbodytag {
1.635     raeburn  5259:     my ($args) = @_;
1.1080    raeburn  5260:     my $endbodytag;
                   5261:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5262:         $endbodytag='</body>';
                   5263:     }
1.269     albertel 5264:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5265:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5266:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5267: 	    $endbodytag=
                   5268: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5269: 	        &mt('Continue').'</a>'.
                   5270: 	        $endbodytag;
                   5271:         }
1.315     albertel 5272:     }
1.251     albertel 5273:     return $endbodytag;
                   5274: }
                   5275: 
1.352     albertel 5276: =pod
                   5277: 
                   5278: =item * &standard_css()
                   5279: 
                   5280: Returns a style sheet
                   5281: 
                   5282: Inputs: (all optional)
                   5283:             domain         -> force to color decorate a page for a specific
                   5284:                                domain
                   5285:             function       -> force usage of a specific rolish color scheme
                   5286:             bgcolor        -> override the default page bgcolor
                   5287: 
                   5288: =cut
                   5289: 
1.343     albertel 5290: sub standard_css {
1.345     albertel 5291:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5292:     $function  = &get_users_function() if (!$function);
                   5293:     my $img    = &designparm($function.'.img',   $domain);
                   5294:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5295:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5296:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5297: #second colour for later usage
1.345     albertel 5298:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5299:     my $pgbg_or_bgcolor =
                   5300: 	         $bgcolor ||
1.352     albertel 5301: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5302:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5303:     my $alink  = &designparm($function.'.alink', $domain);
                   5304:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5305:     my $link   = &designparm($function.'.link',  $domain);
                   5306: 
1.602     albertel 5307:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5308:     my $mono                 = 'monospace';
1.850     bisitz   5309:     my $data_table_head      = $sidebg;
                   5310:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5311:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5312:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5313:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5314:     my $mail_new             = '#FFBB77';
                   5315:     my $mail_new_hover       = '#DD9955';
                   5316:     my $mail_read            = '#BBBB77';
                   5317:     my $mail_read_hover      = '#999944';
                   5318:     my $mail_replied         = '#AAAA88';
                   5319:     my $mail_replied_hover   = '#888855';
                   5320:     my $mail_other           = '#99BBBB';
                   5321:     my $mail_other_hover     = '#669999';
1.391     albertel 5322:     my $table_header         = '#DDDDDD';
1.489     raeburn  5323:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5324:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5325:     my $button_hover         = '#BF2317';
1.392     albertel 5326: 
1.608     albertel 5327:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5328:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5329:                                              : '0 3px 0 4px';
1.448     albertel 5330: 
1.523     albertel 5331: 
1.343     albertel 5332:     return <<END;
1.947     droeschl 5333: 
                   5334: /* needed for iframe to allow 100% height in FF */
                   5335: body, html { 
                   5336:     margin: 0;
                   5337:     padding: 0 0.5%;
                   5338:     height: 99%; /* to avoid scrollbars */
                   5339: }
                   5340: 
1.795     www      5341: body {
1.911     bisitz   5342:   font-family: $sans;
                   5343:   line-height:130%;
                   5344:   font-size:0.83em;
                   5345:   color:$font;
1.795     www      5346: }
                   5347: 
1.959     onken    5348: a:focus,
                   5349: a:focus img {
1.795     www      5350:   color: red;
                   5351: }
1.698     harmsja  5352: 
1.911     bisitz   5353: form, .inline {
                   5354:   display: inline;
1.795     www      5355: }
1.721     harmsja  5356: 
1.795     www      5357: .LC_right {
1.911     bisitz   5358:   text-align:right;
1.795     www      5359: }
                   5360: 
                   5361: .LC_middle {
1.911     bisitz   5362:   vertical-align:middle;
1.795     www      5363: }
1.721     harmsja  5364: 
1.911     bisitz   5365: .LC_400Box {
                   5366:   width:400px;
                   5367: }
1.721     harmsja  5368: 
1.947     droeschl 5369: .LC_iframecontainer {
                   5370:     width: 98%;
                   5371:     margin: 0;
                   5372:     position: fixed;
                   5373:     top: 8.5em;
                   5374:     bottom: 0;
                   5375: }
                   5376: 
                   5377: .LC_iframecontainer iframe{
                   5378:     border: none;
                   5379:     width: 100%;
                   5380:     height: 100%;
                   5381: }
                   5382: 
1.778     bisitz   5383: .LC_filename {
                   5384:   font-family: $mono;
                   5385:   white-space:pre;
1.921     bisitz   5386:   font-size: 120%;
1.778     bisitz   5387: }
                   5388: 
                   5389: .LC_fileicon {
                   5390:   border: none;
                   5391:   height: 1.3em;
                   5392:   vertical-align: text-bottom;
                   5393:   margin-right: 0.3em;
                   5394:   text-decoration:none;
                   5395: }
                   5396: 
1.1008    www      5397: .LC_setting {
                   5398:   text-decoration:underline;
                   5399: }
                   5400: 
1.350     albertel 5401: .LC_error {
                   5402:   color: red;
                   5403:   font-size: larger;
                   5404: }
1.795     www      5405: 
1.457     albertel 5406: .LC_warning,
                   5407: .LC_diff_removed {
1.733     bisitz   5408:   color: red;
1.394     albertel 5409: }
1.532     albertel 5410: 
                   5411: .LC_info,
1.457     albertel 5412: .LC_success,
                   5413: .LC_diff_added {
1.350     albertel 5414:   color: green;
                   5415: }
1.795     www      5416: 
1.802     bisitz   5417: div.LC_confirm_box {
                   5418:   background-color: #FAFAFA;
                   5419:   border: 1px solid $lg_border_color;
                   5420:   margin-right: 0;
                   5421:   padding: 5px;
                   5422: }
                   5423: 
                   5424: div.LC_confirm_box .LC_error img,
                   5425: div.LC_confirm_box .LC_success img {
                   5426:   vertical-align: middle;
                   5427: }
                   5428: 
1.440     albertel 5429: .LC_icon {
1.771     droeschl 5430:   border: none;
1.790     droeschl 5431:   vertical-align: middle;
1.771     droeschl 5432: }
                   5433: 
1.543     albertel 5434: .LC_docs_spacer {
                   5435:   width: 25px;
                   5436:   height: 1px;
1.771     droeschl 5437:   border: none;
1.543     albertel 5438: }
1.346     albertel 5439: 
1.532     albertel 5440: .LC_internal_info {
1.735     bisitz   5441:   color: #999999;
1.532     albertel 5442: }
                   5443: 
1.794     www      5444: .LC_discussion {
1.1050    www      5445:   background: $data_table_dark;
1.911     bisitz   5446:   border: 1px solid black;
                   5447:   margin: 2px;
1.794     www      5448: }
                   5449: 
                   5450: .LC_disc_action_left {
1.1050    www      5451:   background: $sidebg;
1.911     bisitz   5452:   text-align: left;
1.1050    www      5453:   padding: 4px;
                   5454:   margin: 2px;
1.794     www      5455: }
                   5456: 
                   5457: .LC_disc_action_right {
1.1050    www      5458:   background: $sidebg;
1.911     bisitz   5459:   text-align: right;
1.1050    www      5460:   padding: 4px;
                   5461:   margin: 2px;
1.794     www      5462: }
                   5463: 
                   5464: .LC_disc_new_item {
1.911     bisitz   5465:   background: white;
                   5466:   border: 2px solid red;
1.1050    www      5467:   margin: 4px;
                   5468:   padding: 4px;
1.794     www      5469: }
                   5470: 
                   5471: .LC_disc_old_item {
1.911     bisitz   5472:   background: white;
1.1050    www      5473:   margin: 4px;
                   5474:   padding: 4px;
1.794     www      5475: }
                   5476: 
1.458     albertel 5477: table.LC_pastsubmission {
                   5478:   border: 1px solid black;
                   5479:   margin: 2px;
                   5480: }
                   5481: 
1.924     bisitz   5482: table#LC_menubuttons {
1.345     albertel 5483:   width: 100%;
                   5484:   background: $pgbg;
1.392     albertel 5485:   border: 2px;
1.402     albertel 5486:   border-collapse: separate;
1.803     bisitz   5487:   padding: 0;
1.345     albertel 5488: }
1.392     albertel 5489: 
1.801     tempelho 5490: table#LC_title_bar a {
                   5491:   color: $fontmenu;
                   5492: }
1.836     bisitz   5493: 
1.807     droeschl 5494: table#LC_title_bar {
1.819     tempelho 5495:   clear: both;
1.836     bisitz   5496:   display: none;
1.807     droeschl 5497: }
                   5498: 
1.795     www      5499: table#LC_title_bar,
1.933     droeschl 5500: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5501: table#LC_title_bar.LC_with_remote {
1.359     albertel 5502:   width: 100%;
1.392     albertel 5503:   border-color: $pgbg;
                   5504:   border-style: solid;
                   5505:   border-width: $border;
1.379     albertel 5506:   background: $pgbg;
1.801     tempelho 5507:   color: $fontmenu;
1.392     albertel 5508:   border-collapse: collapse;
1.803     bisitz   5509:   padding: 0;
1.819     tempelho 5510:   margin: 0;
1.359     albertel 5511: }
1.795     www      5512: 
1.933     droeschl 5513: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5514:     margin: 0;
                   5515:     padding: 0;
1.933     droeschl 5516:     position: relative;
                   5517:     list-style: none;
1.913     droeschl 5518: }
1.933     droeschl 5519: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5520:     display: inline;
                   5521: }
1.933     droeschl 5522: 
                   5523: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5524:     padding: 0;
1.933     droeschl 5525:     margin: 0;
                   5526:     float: left;
1.913     droeschl 5527: }
1.933     droeschl 5528: .LC_breadcrumb_tools_tools {
                   5529:     padding: 0;
                   5530:     margin: 0;
1.913     droeschl 5531:     float: right;
                   5532: }
                   5533: 
1.359     albertel 5534: table#LC_title_bar td {
                   5535:   background: $tabbg;
                   5536: }
1.795     www      5537: 
1.911     bisitz   5538: table#LC_menubuttons img {
1.803     bisitz   5539:   border: none;
1.346     albertel 5540: }
1.795     www      5541: 
1.842     droeschl 5542: .LC_breadcrumbs_component {
1.911     bisitz   5543:   float: right;
                   5544:   margin: 0 1em;
1.357     albertel 5545: }
1.842     droeschl 5546: .LC_breadcrumbs_component img {
1.911     bisitz   5547:   vertical-align: middle;
1.777     tempelho 5548: }
1.795     www      5549: 
1.383     albertel 5550: td.LC_table_cell_checkbox {
                   5551:   text-align: center;
                   5552: }
1.795     www      5553: 
                   5554: .LC_fontsize_small {
1.911     bisitz   5555:   font-size: 70%;
1.705     tempelho 5556: }
                   5557: 
1.844     bisitz   5558: #LC_breadcrumbs {
1.911     bisitz   5559:   clear:both;
                   5560:   background: $sidebg;
                   5561:   border-bottom: 1px solid $lg_border_color;
                   5562:   line-height: 2.5em;
1.933     droeschl 5563:   overflow: hidden;
1.911     bisitz   5564:   margin: 0;
                   5565:   padding: 0;
1.995     raeburn  5566:   text-align: left;
1.819     tempelho 5567: }
1.862     bisitz   5568: 
1.993     raeburn  5569: .LC_head_subbox {
1.911     bisitz   5570:   clear:both;
                   5571:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5572:   border: 1px solid $sidebg;
                   5573:   margin: 0 0 10px 0;      
1.966     bisitz   5574:   padding: 3px;
1.995     raeburn  5575:   text-align: left;
1.822     bisitz   5576: }
                   5577: 
1.795     www      5578: .LC_fontsize_medium {
1.911     bisitz   5579:   font-size: 85%;
1.705     tempelho 5580: }
                   5581: 
1.795     www      5582: .LC_fontsize_large {
1.911     bisitz   5583:   font-size: 120%;
1.705     tempelho 5584: }
                   5585: 
1.346     albertel 5586: .LC_menubuttons_inline_text {
                   5587:   color: $font;
1.698     harmsja  5588:   font-size: 90%;
1.701     harmsja  5589:   padding-left:3px;
1.346     albertel 5590: }
                   5591: 
1.934     droeschl 5592: .LC_menubuttons_inline_text img{
                   5593:   vertical-align: middle;
                   5594: }
                   5595: 
1.1051    www      5596: li.LC_menubuttons_inline_text img {
1.951     onken    5597:   cursor:pointer;
1.1002    droeschl 5598:   text-decoration: none;
1.951     onken    5599: }
                   5600: 
1.526     www      5601: .LC_menubuttons_link {
                   5602:   text-decoration: none;
                   5603: }
1.795     www      5604: 
1.522     albertel 5605: .LC_menubuttons_category {
1.521     www      5606:   color: $font;
1.526     www      5607:   background: $pgbg;
1.521     www      5608:   font-size: larger;
                   5609:   font-weight: bold;
                   5610: }
                   5611: 
1.346     albertel 5612: td.LC_menubuttons_text {
1.911     bisitz   5613:   color: $font;
1.346     albertel 5614: }
1.706     harmsja  5615: 
1.346     albertel 5616: .LC_current_location {
                   5617:   background: $tabbg;
                   5618: }
1.795     www      5619: 
1.938     bisitz   5620: table.LC_data_table {
1.347     albertel 5621:   border: 1px solid #000000;
1.402     albertel 5622:   border-collapse: separate;
1.426     albertel 5623:   border-spacing: 1px;
1.610     albertel 5624:   background: $pgbg;
1.347     albertel 5625: }
1.795     www      5626: 
1.422     albertel 5627: .LC_data_table_dense {
                   5628:   font-size: small;
                   5629: }
1.795     www      5630: 
1.507     raeburn  5631: table.LC_nested_outer {
                   5632:   border: 1px solid #000000;
1.589     raeburn  5633:   border-collapse: collapse;
1.803     bisitz   5634:   border-spacing: 0;
1.507     raeburn  5635:   width: 100%;
                   5636: }
1.795     www      5637: 
1.879     raeburn  5638: table.LC_innerpickbox,
1.507     raeburn  5639: table.LC_nested {
1.803     bisitz   5640:   border: none;
1.589     raeburn  5641:   border-collapse: collapse;
1.803     bisitz   5642:   border-spacing: 0;
1.507     raeburn  5643:   width: 100%;
                   5644: }
1.795     www      5645: 
1.911     bisitz   5646: table.LC_data_table tr th,
                   5647: table.LC_calendar tr th,
1.879     raeburn  5648: table.LC_prior_tries tr th,
                   5649: table.LC_innerpickbox tr th {
1.349     albertel 5650:   font-weight: bold;
                   5651:   background-color: $data_table_head;
1.801     tempelho 5652:   color:$fontmenu;
1.701     harmsja  5653:   font-size:90%;
1.347     albertel 5654: }
1.795     www      5655: 
1.879     raeburn  5656: table.LC_innerpickbox tr th,
                   5657: table.LC_innerpickbox tr td {
                   5658:   vertical-align: top;
                   5659: }
                   5660: 
1.711     raeburn  5661: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5662:   background-color: #CCCCCC;
1.711     raeburn  5663:   font-weight: bold;
                   5664:   text-align: left;
                   5665: }
1.795     www      5666: 
1.912     bisitz   5667: table.LC_data_table tr.LC_odd_row > td {
                   5668:   background-color: $data_table_light;
                   5669:   padding: 2px;
                   5670:   vertical-align: top;
                   5671: }
                   5672: 
1.809     bisitz   5673: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5674:   background-color: $data_table_light;
1.912     bisitz   5675:   vertical-align: top;
                   5676: }
                   5677: 
                   5678: table.LC_data_table tr.LC_even_row > td {
                   5679:   background-color: $data_table_dark;
1.425     albertel 5680:   padding: 2px;
1.900     bisitz   5681:   vertical-align: top;
1.347     albertel 5682: }
1.795     www      5683: 
1.809     bisitz   5684: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5685:   background-color: $data_table_dark;
1.900     bisitz   5686:   vertical-align: top;
1.347     albertel 5687: }
1.795     www      5688: 
1.425     albertel 5689: table.LC_data_table tr.LC_data_table_highlight td {
                   5690:   background-color: $data_table_darker;
                   5691: }
1.795     www      5692: 
1.639     raeburn  5693: table.LC_data_table tr td.LC_leftcol_header {
                   5694:   background-color: $data_table_head;
                   5695:   font-weight: bold;
                   5696: }
1.795     www      5697: 
1.451     albertel 5698: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5699: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5700:   font-weight: bold;
                   5701:   font-style: italic;
                   5702:   text-align: center;
                   5703:   padding: 8px;
1.347     albertel 5704: }
1.795     www      5705: 
1.940     bisitz   5706: table.LC_data_table tr.LC_empty_row td {
                   5707:   background-color: $sidebg;
                   5708: }
                   5709: 
                   5710: table.LC_nested tr.LC_empty_row td {
                   5711:   background-color: #FFFFFF;
                   5712: }
                   5713: 
1.890     droeschl 5714: table.LC_caption {
                   5715: }
                   5716: 
1.507     raeburn  5717: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5718:   padding: 4ex
                   5719: }
1.795     www      5720: 
1.507     raeburn  5721: table.LC_nested_outer tr th {
                   5722:   font-weight: bold;
1.801     tempelho 5723:   color:$fontmenu;
1.507     raeburn  5724:   background-color: $data_table_head;
1.701     harmsja  5725:   font-size: small;
1.507     raeburn  5726:   border-bottom: 1px solid #000000;
                   5727: }
1.795     www      5728: 
1.507     raeburn  5729: table.LC_nested_outer tr td.LC_subheader {
                   5730:   background-color: $data_table_head;
                   5731:   font-weight: bold;
                   5732:   font-size: small;
                   5733:   border-bottom: 1px solid #000000;
                   5734:   text-align: right;
1.451     albertel 5735: }
1.795     www      5736: 
1.507     raeburn  5737: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5738:   background-color: #CCCCCC;
1.451     albertel 5739:   font-weight: bold;
                   5740:   font-size: small;
1.507     raeburn  5741:   text-align: center;
                   5742: }
1.795     www      5743: 
1.589     raeburn  5744: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5745: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5746:   text-align: left;
1.451     albertel 5747: }
1.795     www      5748: 
1.507     raeburn  5749: table.LC_nested td {
1.735     bisitz   5750:   background-color: #FFFFFF;
1.451     albertel 5751:   font-size: small;
1.507     raeburn  5752: }
1.795     www      5753: 
1.507     raeburn  5754: table.LC_nested_outer tr th.LC_right_item,
                   5755: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5756: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5757: table.LC_nested tr td.LC_right_item {
1.451     albertel 5758:   text-align: right;
                   5759: }
                   5760: 
1.507     raeburn  5761: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5762:   background-color: #EEEEEE;
1.451     albertel 5763: }
                   5764: 
1.473     raeburn  5765: table.LC_createuser {
                   5766: }
                   5767: 
                   5768: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5769:   font-size: small;
1.473     raeburn  5770: }
                   5771: 
                   5772: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5773:   background-color: #CCCCCC;
1.473     raeburn  5774:   font-weight: bold;
                   5775:   text-align: center;
                   5776: }
                   5777: 
1.349     albertel 5778: table.LC_calendar {
                   5779:   border: 1px solid #000000;
                   5780:   border-collapse: collapse;
1.917     raeburn  5781:   width: 98%;
1.349     albertel 5782: }
1.795     www      5783: 
1.349     albertel 5784: table.LC_calendar_pickdate {
                   5785:   font-size: xx-small;
                   5786: }
1.795     www      5787: 
1.349     albertel 5788: table.LC_calendar tr td {
                   5789:   border: 1px solid #000000;
                   5790:   vertical-align: top;
1.917     raeburn  5791:   width: 14%;
1.349     albertel 5792: }
1.795     www      5793: 
1.349     albertel 5794: table.LC_calendar tr td.LC_calendar_day_empty {
                   5795:   background-color: $data_table_dark;
                   5796: }
1.795     www      5797: 
1.779     bisitz   5798: table.LC_calendar tr td.LC_calendar_day_current {
                   5799:   background-color: $data_table_highlight;
1.777     tempelho 5800: }
1.795     www      5801: 
1.938     bisitz   5802: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5803:   background-color: $mail_new;
                   5804: }
1.795     www      5805: 
1.938     bisitz   5806: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5807:   background-color: $mail_new_hover;
                   5808: }
1.795     www      5809: 
1.938     bisitz   5810: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5811:   background-color: $mail_read;
                   5812: }
1.795     www      5813: 
1.938     bisitz   5814: /*
                   5815: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5816:   background-color: $mail_read_hover;
                   5817: }
1.938     bisitz   5818: */
1.795     www      5819: 
1.938     bisitz   5820: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5821:   background-color: $mail_replied;
                   5822: }
1.795     www      5823: 
1.938     bisitz   5824: /*
                   5825: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5826:   background-color: $mail_replied_hover;
                   5827: }
1.938     bisitz   5828: */
1.795     www      5829: 
1.938     bisitz   5830: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5831:   background-color: $mail_other;
                   5832: }
1.795     www      5833: 
1.938     bisitz   5834: /*
                   5835: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5836:   background-color: $mail_other_hover;
                   5837: }
1.938     bisitz   5838: */
1.494     raeburn  5839: 
1.777     tempelho 5840: table.LC_data_table tr > td.LC_browser_file,
                   5841: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5842:   background: #AAEE77;
1.389     albertel 5843: }
1.795     www      5844: 
1.777     tempelho 5845: table.LC_data_table tr > td.LC_browser_file_locked,
                   5846: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5847:   background: #FFAA99;
1.387     albertel 5848: }
1.795     www      5849: 
1.777     tempelho 5850: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5851:   background: #888888;
1.779     bisitz   5852: }
1.795     www      5853: 
1.777     tempelho 5854: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5855: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5856:   background: #F8F866;
1.777     tempelho 5857: }
1.795     www      5858: 
1.696     bisitz   5859: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5860:   background: #E0E8FF;
1.387     albertel 5861: }
1.696     bisitz   5862: 
1.707     bisitz   5863: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5864:   /* background: #77FF77; */
1.707     bisitz   5865: }
1.795     www      5866: 
1.707     bisitz   5867: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5868:   border-right: 8px solid #FFFF77;
1.707     bisitz   5869: }
1.795     www      5870: 
1.707     bisitz   5871: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5872:   border-right: 8px solid #FFAA77;
1.707     bisitz   5873: }
1.795     www      5874: 
1.707     bisitz   5875: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5876:   border-right: 8px solid #FF7777;
1.707     bisitz   5877: }
1.795     www      5878: 
1.707     bisitz   5879: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5880:   border-right: 8px solid #AAFF77;
1.707     bisitz   5881: }
1.795     www      5882: 
1.707     bisitz   5883: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5884:   border-right: 8px solid #11CC55;
1.707     bisitz   5885: }
                   5886: 
1.388     albertel 5887: span.LC_current_location {
1.701     harmsja  5888:   font-size:larger;
1.388     albertel 5889:   background: $pgbg;
                   5890: }
1.387     albertel 5891: 
1.1029    www      5892: span.LC_current_nav_location {
                   5893:   font-weight:bold;
                   5894:   background: $sidebg;
                   5895: }
                   5896: 
1.395     albertel 5897: span.LC_parm_menu_item {
                   5898:   font-size: larger;
                   5899: }
1.795     www      5900: 
1.395     albertel 5901: span.LC_parm_scope_all {
                   5902:   color: red;
                   5903: }
1.795     www      5904: 
1.395     albertel 5905: span.LC_parm_scope_folder {
                   5906:   color: green;
                   5907: }
1.795     www      5908: 
1.395     albertel 5909: span.LC_parm_scope_resource {
                   5910:   color: orange;
                   5911: }
1.795     www      5912: 
1.395     albertel 5913: span.LC_parm_part {
                   5914:   color: blue;
                   5915: }
1.795     www      5916: 
1.911     bisitz   5917: span.LC_parm_folder,
                   5918: span.LC_parm_symb {
1.395     albertel 5919:   font-size: x-small;
                   5920:   font-family: $mono;
                   5921:   color: #AAAAAA;
                   5922: }
                   5923: 
1.977     bisitz   5924: ul.LC_parm_parmlist li {
                   5925:   display: inline-block;
                   5926:   padding: 0.3em 0.8em;
                   5927:   vertical-align: top;
                   5928:   width: 150px;
                   5929:   border-top:1px solid $lg_border_color;
                   5930: }
                   5931: 
1.795     www      5932: td.LC_parm_overview_level_menu,
                   5933: td.LC_parm_overview_map_menu,
                   5934: td.LC_parm_overview_parm_selectors,
                   5935: td.LC_parm_overview_restrictions  {
1.396     albertel 5936:   border: 1px solid black;
                   5937:   border-collapse: collapse;
                   5938: }
1.795     www      5939: 
1.396     albertel 5940: table.LC_parm_overview_restrictions td {
                   5941:   border-width: 1px 4px 1px 4px;
                   5942:   border-style: solid;
                   5943:   border-color: $pgbg;
                   5944:   text-align: center;
                   5945: }
1.795     www      5946: 
1.396     albertel 5947: table.LC_parm_overview_restrictions th {
                   5948:   background: $tabbg;
                   5949:   border-width: 1px 4px 1px 4px;
                   5950:   border-style: solid;
                   5951:   border-color: $pgbg;
                   5952: }
1.795     www      5953: 
1.398     albertel 5954: table#LC_helpmenu {
1.803     bisitz   5955:   border: none;
1.398     albertel 5956:   height: 55px;
1.803     bisitz   5957:   border-spacing: 0;
1.398     albertel 5958: }
                   5959: 
                   5960: table#LC_helpmenu fieldset legend {
                   5961:   font-size: larger;
                   5962: }
1.795     www      5963: 
1.397     albertel 5964: table#LC_helpmenu_links {
                   5965:   width: 100%;
                   5966:   border: 1px solid black;
                   5967:   background: $pgbg;
1.803     bisitz   5968:   padding: 0;
1.397     albertel 5969:   border-spacing: 1px;
                   5970: }
1.795     www      5971: 
1.397     albertel 5972: table#LC_helpmenu_links tr td {
                   5973:   padding: 1px;
                   5974:   background: $tabbg;
1.399     albertel 5975:   text-align: center;
                   5976:   font-weight: bold;
1.397     albertel 5977: }
1.396     albertel 5978: 
1.795     www      5979: table#LC_helpmenu_links a:link,
                   5980: table#LC_helpmenu_links a:visited,
1.397     albertel 5981: table#LC_helpmenu_links a:active {
                   5982:   text-decoration: none;
                   5983:   color: $font;
                   5984: }
1.795     www      5985: 
1.397     albertel 5986: table#LC_helpmenu_links a:hover {
                   5987:   text-decoration: underline;
                   5988:   color: $vlink;
                   5989: }
1.396     albertel 5990: 
1.417     albertel 5991: .LC_chrt_popup_exists {
                   5992:   border: 1px solid #339933;
                   5993:   margin: -1px;
                   5994: }
1.795     www      5995: 
1.417     albertel 5996: .LC_chrt_popup_up {
                   5997:   border: 1px solid yellow;
                   5998:   margin: -1px;
                   5999: }
1.795     www      6000: 
1.417     albertel 6001: .LC_chrt_popup {
                   6002:   border: 1px solid #8888FF;
                   6003:   background: #CCCCFF;
                   6004: }
1.795     www      6005: 
1.421     albertel 6006: table.LC_pick_box {
                   6007:   border-collapse: separate;
                   6008:   background: white;
                   6009:   border: 1px solid black;
                   6010:   border-spacing: 1px;
                   6011: }
1.795     www      6012: 
1.421     albertel 6013: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6014:   background: $sidebg;
1.421     albertel 6015:   font-weight: bold;
1.900     bisitz   6016:   text-align: left;
1.740     bisitz   6017:   vertical-align: top;
1.421     albertel 6018:   width: 184px;
                   6019:   padding: 8px;
                   6020: }
1.795     www      6021: 
1.579     raeburn  6022: table.LC_pick_box td.LC_pick_box_value {
                   6023:   text-align: left;
                   6024:   padding: 8px;
                   6025: }
1.795     www      6026: 
1.579     raeburn  6027: table.LC_pick_box td.LC_pick_box_select {
                   6028:   text-align: left;
                   6029:   padding: 8px;
                   6030: }
1.795     www      6031: 
1.424     albertel 6032: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6033:   padding: 0;
1.421     albertel 6034:   height: 1px;
                   6035:   background: black;
                   6036: }
1.795     www      6037: 
1.421     albertel 6038: table.LC_pick_box td.LC_pick_box_submit {
                   6039:   text-align: right;
                   6040: }
1.795     www      6041: 
1.579     raeburn  6042: table.LC_pick_box td.LC_evenrow_value {
                   6043:   text-align: left;
                   6044:   padding: 8px;
                   6045:   background-color: $data_table_light;
                   6046: }
1.795     www      6047: 
1.579     raeburn  6048: table.LC_pick_box td.LC_oddrow_value {
                   6049:   text-align: left;
                   6050:   padding: 8px;
                   6051:   background-color: $data_table_light;
                   6052: }
1.795     www      6053: 
1.579     raeburn  6054: span.LC_helpform_receipt_cat {
                   6055:   font-weight: bold;
                   6056: }
1.795     www      6057: 
1.424     albertel 6058: table.LC_group_priv_box {
                   6059:   background: white;
                   6060:   border: 1px solid black;
                   6061:   border-spacing: 1px;
                   6062: }
1.795     www      6063: 
1.424     albertel 6064: table.LC_group_priv_box td.LC_pick_box_title {
                   6065:   background: $tabbg;
                   6066:   font-weight: bold;
                   6067:   text-align: right;
                   6068:   width: 184px;
                   6069: }
1.795     www      6070: 
1.424     albertel 6071: table.LC_group_priv_box td.LC_groups_fixed {
                   6072:   background: $data_table_light;
                   6073:   text-align: center;
                   6074: }
1.795     www      6075: 
1.424     albertel 6076: table.LC_group_priv_box td.LC_groups_optional {
                   6077:   background: $data_table_dark;
                   6078:   text-align: center;
                   6079: }
1.795     www      6080: 
1.424     albertel 6081: table.LC_group_priv_box td.LC_groups_functionality {
                   6082:   background: $data_table_darker;
                   6083:   text-align: center;
                   6084:   font-weight: bold;
                   6085: }
1.795     www      6086: 
1.424     albertel 6087: table.LC_group_priv td {
                   6088:   text-align: left;
1.803     bisitz   6089:   padding: 0;
1.424     albertel 6090: }
                   6091: 
                   6092: .LC_navbuttons {
                   6093:   margin: 2ex 0ex 2ex 0ex;
                   6094: }
1.795     www      6095: 
1.423     albertel 6096: .LC_topic_bar {
                   6097:   font-weight: bold;
                   6098:   background: $tabbg;
1.918     wenzelju 6099:   margin: 1em 0em 1em 2em;
1.805     bisitz   6100:   padding: 3px;
1.918     wenzelju 6101:   font-size: 1.2em;
1.423     albertel 6102: }
1.795     www      6103: 
1.423     albertel 6104: .LC_topic_bar span {
1.918     wenzelju 6105:   left: 0.5em;
                   6106:   position: absolute;
1.423     albertel 6107:   vertical-align: middle;
1.918     wenzelju 6108:   font-size: 1.2em;
1.423     albertel 6109: }
1.795     www      6110: 
1.423     albertel 6111: table.LC_course_group_status {
                   6112:   margin: 20px;
                   6113: }
1.795     www      6114: 
1.423     albertel 6115: table.LC_status_selector td {
                   6116:   vertical-align: top;
                   6117:   text-align: center;
1.424     albertel 6118:   padding: 4px;
                   6119: }
1.795     www      6120: 
1.599     albertel 6121: div.LC_feedback_link {
1.616     albertel 6122:   clear: both;
1.829     kalberla 6123:   background: $sidebg;
1.779     bisitz   6124:   width: 100%;
1.829     kalberla 6125:   padding-bottom: 10px;
                   6126:   border: 1px $tabbg solid;
1.833     kalberla 6127:   height: 22px;
                   6128:   line-height: 22px;
                   6129:   padding-top: 5px;
                   6130: }
                   6131: 
                   6132: div.LC_feedback_link img {
                   6133:   height: 22px;
1.867     kalberla 6134:   vertical-align:middle;
1.829     kalberla 6135: }
                   6136: 
1.911     bisitz   6137: div.LC_feedback_link a {
1.829     kalberla 6138:   text-decoration: none;
1.489     raeburn  6139: }
1.795     www      6140: 
1.867     kalberla 6141: div.LC_comblock {
1.911     bisitz   6142:   display:inline;
1.867     kalberla 6143:   color:$font;
                   6144:   font-size:90%;
                   6145: }
                   6146: 
                   6147: div.LC_feedback_link div.LC_comblock {
                   6148:   padding-left:5px;
                   6149: }
                   6150: 
                   6151: div.LC_feedback_link div.LC_comblock a {
                   6152:   color:$font;
                   6153: }
                   6154: 
1.489     raeburn  6155: span.LC_feedback_link {
1.858     bisitz   6156:   /* background: $feedback_link_bg; */
1.599     albertel 6157:   font-size: larger;
                   6158: }
1.795     www      6159: 
1.599     albertel 6160: span.LC_message_link {
1.858     bisitz   6161:   /* background: $feedback_link_bg; */
1.599     albertel 6162:   font-size: larger;
                   6163:   position: absolute;
                   6164:   right: 1em;
1.489     raeburn  6165: }
1.421     albertel 6166: 
1.515     albertel 6167: table.LC_prior_tries {
1.524     albertel 6168:   border: 1px solid #000000;
                   6169:   border-collapse: separate;
                   6170:   border-spacing: 1px;
1.515     albertel 6171: }
1.523     albertel 6172: 
1.515     albertel 6173: table.LC_prior_tries td {
1.524     albertel 6174:   padding: 2px;
1.515     albertel 6175: }
1.523     albertel 6176: 
                   6177: .LC_answer_correct {
1.795     www      6178:   background: lightgreen;
                   6179:   color: darkgreen;
                   6180:   padding: 6px;
1.523     albertel 6181: }
1.795     www      6182: 
1.523     albertel 6183: .LC_answer_charged_try {
1.797     www      6184:   background: #FFAAAA;
1.795     www      6185:   color: darkred;
                   6186:   padding: 6px;
1.523     albertel 6187: }
1.795     www      6188: 
1.779     bisitz   6189: .LC_answer_not_charged_try,
1.523     albertel 6190: .LC_answer_no_grade,
                   6191: .LC_answer_late {
1.795     www      6192:   background: lightyellow;
1.523     albertel 6193:   color: black;
1.795     www      6194:   padding: 6px;
1.523     albertel 6195: }
1.795     www      6196: 
1.523     albertel 6197: .LC_answer_previous {
1.795     www      6198:   background: lightblue;
                   6199:   color: darkblue;
                   6200:   padding: 6px;
1.523     albertel 6201: }
1.795     www      6202: 
1.779     bisitz   6203: .LC_answer_no_message {
1.777     tempelho 6204:   background: #FFFFFF;
                   6205:   color: black;
1.795     www      6206:   padding: 6px;
1.779     bisitz   6207: }
1.795     www      6208: 
1.779     bisitz   6209: .LC_answer_unknown {
                   6210:   background: orange;
                   6211:   color: black;
1.795     www      6212:   padding: 6px;
1.777     tempelho 6213: }
1.795     www      6214: 
1.529     albertel 6215: span.LC_prior_numerical,
                   6216: span.LC_prior_string,
                   6217: span.LC_prior_custom,
                   6218: span.LC_prior_reaction,
                   6219: span.LC_prior_math {
1.925     bisitz   6220:   font-family: $mono;
1.523     albertel 6221:   white-space: pre;
                   6222: }
                   6223: 
1.525     albertel 6224: span.LC_prior_string {
1.925     bisitz   6225:   font-family: $mono;
1.525     albertel 6226:   white-space: pre;
                   6227: }
                   6228: 
1.523     albertel 6229: table.LC_prior_option {
                   6230:   width: 100%;
                   6231:   border-collapse: collapse;
                   6232: }
1.795     www      6233: 
1.911     bisitz   6234: table.LC_prior_rank,
1.795     www      6235: table.LC_prior_match {
1.528     albertel 6236:   border-collapse: collapse;
                   6237: }
1.795     www      6238: 
1.528     albertel 6239: table.LC_prior_option tr td,
                   6240: table.LC_prior_rank tr td,
                   6241: table.LC_prior_match tr td {
1.524     albertel 6242:   border: 1px solid #000000;
1.515     albertel 6243: }
                   6244: 
1.855     bisitz   6245: .LC_nobreak {
1.544     albertel 6246:   white-space: nowrap;
1.519     raeburn  6247: }
                   6248: 
1.576     raeburn  6249: span.LC_cusr_emph {
                   6250:   font-style: italic;
                   6251: }
                   6252: 
1.633     raeburn  6253: span.LC_cusr_subheading {
                   6254:   font-weight: normal;
                   6255:   font-size: 85%;
                   6256: }
                   6257: 
1.861     bisitz   6258: div.LC_docs_entry_move {
1.859     bisitz   6259:   border: 1px solid #BBBBBB;
1.545     albertel 6260:   background: #DDDDDD;
1.861     bisitz   6261:   width: 22px;
1.859     bisitz   6262:   padding: 1px;
                   6263:   margin: 0;
1.545     albertel 6264: }
                   6265: 
1.861     bisitz   6266: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6267: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6268:   background: #DDDDDD;
                   6269:   font-size: x-small;
                   6270: }
1.795     www      6271: 
1.861     bisitz   6272: .LC_docs_entry_parameter {
                   6273:   white-space: nowrap;
                   6274: }
                   6275: 
1.544     albertel 6276: .LC_docs_copy {
1.545     albertel 6277:   color: #000099;
1.544     albertel 6278: }
1.795     www      6279: 
1.544     albertel 6280: .LC_docs_cut {
1.545     albertel 6281:   color: #550044;
1.544     albertel 6282: }
1.795     www      6283: 
1.544     albertel 6284: .LC_docs_rename {
1.545     albertel 6285:   color: #009900;
1.544     albertel 6286: }
1.795     www      6287: 
1.544     albertel 6288: .LC_docs_remove {
1.545     albertel 6289:   color: #990000;
                   6290: }
                   6291: 
1.547     albertel 6292: .LC_docs_reinit_warn,
                   6293: .LC_docs_ext_edit {
                   6294:   font-size: x-small;
                   6295: }
                   6296: 
1.545     albertel 6297: table.LC_docs_adddocs td,
                   6298: table.LC_docs_adddocs th {
                   6299:   border: 1px solid #BBBBBB;
                   6300:   padding: 4px;
                   6301:   background: #DDDDDD;
1.543     albertel 6302: }
                   6303: 
1.584     albertel 6304: table.LC_sty_begin {
                   6305:   background: #BBFFBB;
                   6306: }
1.795     www      6307: 
1.584     albertel 6308: table.LC_sty_end {
                   6309:   background: #FFBBBB;
                   6310: }
                   6311: 
1.589     raeburn  6312: table.LC_double_column {
1.803     bisitz   6313:   border-width: 0;
1.589     raeburn  6314:   border-collapse: collapse;
                   6315:   width: 100%;
                   6316:   padding: 2px;
                   6317: }
                   6318: 
                   6319: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6320:   top: 2px;
1.589     raeburn  6321:   left: 2px;
                   6322:   width: 47%;
                   6323:   vertical-align: top;
                   6324: }
                   6325: 
                   6326: table.LC_double_column tr td.LC_right_col {
                   6327:   top: 2px;
1.779     bisitz   6328:   right: 2px;
1.589     raeburn  6329:   width: 47%;
                   6330:   vertical-align: top;
                   6331: }
                   6332: 
1.591     raeburn  6333: div.LC_left_float {
                   6334:   float: left;
                   6335:   padding-right: 5%;
1.597     albertel 6336:   padding-bottom: 4px;
1.591     raeburn  6337: }
                   6338: 
                   6339: div.LC_clear_float_header {
1.597     albertel 6340:   padding-bottom: 2px;
1.591     raeburn  6341: }
                   6342: 
                   6343: div.LC_clear_float_footer {
1.597     albertel 6344:   padding-top: 10px;
1.591     raeburn  6345:   clear: both;
                   6346: }
                   6347: 
1.597     albertel 6348: div.LC_grade_show_user {
1.941     bisitz   6349: /*  border-left: 5px solid $sidebg; */
                   6350:   border-top: 5px solid #000000;
                   6351:   margin: 50px 0 0 0;
1.936     bisitz   6352:   padding: 15px 0 5px 10px;
1.597     albertel 6353: }
1.795     www      6354: 
1.936     bisitz   6355: div.LC_grade_show_user_odd_row {
1.941     bisitz   6356: /*  border-left: 5px solid #000000; */
                   6357: }
                   6358: 
                   6359: div.LC_grade_show_user div.LC_Box {
                   6360:   margin-right: 50px;
1.597     albertel 6361: }
                   6362: 
                   6363: div.LC_grade_submissions,
                   6364: div.LC_grade_message_center,
1.936     bisitz   6365: div.LC_grade_info_links {
1.597     albertel 6366:   margin: 5px;
                   6367:   width: 99%;
                   6368:   background: #FFFFFF;
                   6369: }
1.795     www      6370: 
1.597     albertel 6371: div.LC_grade_submissions_header,
1.936     bisitz   6372: div.LC_grade_message_center_header {
1.705     tempelho 6373:   font-weight: bold;
                   6374:   font-size: large;
1.597     albertel 6375: }
1.795     www      6376: 
1.597     albertel 6377: div.LC_grade_submissions_body,
1.936     bisitz   6378: div.LC_grade_message_center_body {
1.597     albertel 6379:   border: 1px solid black;
                   6380:   width: 99%;
                   6381:   background: #FFFFFF;
                   6382: }
1.795     www      6383: 
1.613     albertel 6384: table.LC_scantron_action {
                   6385:   width: 100%;
                   6386: }
1.795     www      6387: 
1.613     albertel 6388: table.LC_scantron_action tr th {
1.698     harmsja  6389:   font-weight:bold;
                   6390:   font-style:normal;
1.613     albertel 6391: }
1.795     www      6392: 
1.779     bisitz   6393: .LC_edit_problem_header,
1.614     albertel 6394: div.LC_edit_problem_footer {
1.705     tempelho 6395:   font-weight: normal;
                   6396:   font-size:  medium;
1.602     albertel 6397:   margin: 2px;
1.1060    bisitz   6398:   background-color: $sidebg;
1.600     albertel 6399: }
1.795     www      6400: 
1.600     albertel 6401: div.LC_edit_problem_header,
1.602     albertel 6402: div.LC_edit_problem_header div,
1.614     albertel 6403: div.LC_edit_problem_footer,
                   6404: div.LC_edit_problem_footer div,
1.602     albertel 6405: div.LC_edit_problem_editxml_header,
                   6406: div.LC_edit_problem_editxml_header div {
1.600     albertel 6407:   margin-top: 5px;
                   6408: }
1.795     www      6409: 
1.600     albertel 6410: div.LC_edit_problem_header_title {
1.705     tempelho 6411:   font-weight: bold;
                   6412:   font-size: larger;
1.602     albertel 6413:   background: $tabbg;
                   6414:   padding: 3px;
1.1060    bisitz   6415:   margin: 0 0 5px 0;
1.602     albertel 6416: }
1.795     www      6417: 
1.602     albertel 6418: table.LC_edit_problem_header_title {
                   6419:   width: 100%;
1.600     albertel 6420:   background: $tabbg;
1.602     albertel 6421: }
                   6422: 
                   6423: div.LC_edit_problem_discards {
                   6424:   float: left;
                   6425:   padding-bottom: 5px;
                   6426: }
1.795     www      6427: 
1.602     albertel 6428: div.LC_edit_problem_saves {
                   6429:   float: right;
                   6430:   padding-bottom: 5px;
1.600     albertel 6431: }
1.795     www      6432: 
1.911     bisitz   6433: img.stift {
1.803     bisitz   6434:   border-width: 0;
                   6435:   vertical-align: middle;
1.677     riegler  6436: }
1.680     riegler  6437: 
1.923     bisitz   6438: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6439:   vertical-align: top;
1.777     tempelho 6440: }
1.795     www      6441: 
1.716     raeburn  6442: div.LC_createcourse {
1.911     bisitz   6443:   margin: 10px 10px 10px 10px;
1.716     raeburn  6444: }
                   6445: 
1.917     raeburn  6446: .LC_dccid {
                   6447:   margin: 0.2em 0 0 0;
                   6448:   padding: 0;
                   6449:   font-size: 90%;
                   6450:   display:none;
                   6451: }
                   6452: 
1.897     wenzelju 6453: ol.LC_primary_menu a:hover,
1.721     harmsja  6454: ol#LC_MenuBreadcrumbs a:hover,
                   6455: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6456: ul#LC_secondary_menu a:hover,
1.721     harmsja  6457: .LC_FormSectionClearButton input:hover
1.795     www      6458: ul.LC_TabContent   li:hover a {
1.952     onken    6459:   color:$button_hover;
1.911     bisitz   6460:   text-decoration:none;
1.693     droeschl 6461: }
                   6462: 
1.779     bisitz   6463: h1 {
1.911     bisitz   6464:   padding: 0;
                   6465:   line-height:130%;
1.693     droeschl 6466: }
1.698     harmsja  6467: 
1.911     bisitz   6468: h2,
                   6469: h3,
                   6470: h4,
                   6471: h5,
                   6472: h6 {
                   6473:   margin: 5px 0 5px 0;
                   6474:   padding: 0;
                   6475:   line-height:130%;
1.693     droeschl 6476: }
1.795     www      6477: 
                   6478: .LC_hcell {
1.911     bisitz   6479:   padding:3px 15px 3px 15px;
                   6480:   margin: 0;
                   6481:   background-color:$tabbg;
                   6482:   color:$fontmenu;
                   6483:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6484: }
1.795     www      6485: 
1.840     bisitz   6486: .LC_Box > .LC_hcell {
1.911     bisitz   6487:   margin: 0 -10px 10px -10px;
1.835     bisitz   6488: }
                   6489: 
1.721     harmsja  6490: .LC_noBorder {
1.911     bisitz   6491:   border: 0;
1.698     harmsja  6492: }
1.693     droeschl 6493: 
1.721     harmsja  6494: .LC_FormSectionClearButton input {
1.911     bisitz   6495:   background-color:transparent;
                   6496:   border: none;
                   6497:   cursor:pointer;
                   6498:   text-decoration:underline;
1.693     droeschl 6499: }
1.763     bisitz   6500: 
                   6501: .LC_help_open_topic {
1.911     bisitz   6502:   color: #FFFFFF;
                   6503:   background-color: #EEEEFF;
                   6504:   margin: 1px;
                   6505:   padding: 4px;
                   6506:   border: 1px solid #000033;
                   6507:   white-space: nowrap;
                   6508:   /* vertical-align: middle; */
1.759     neumanie 6509: }
1.693     droeschl 6510: 
1.911     bisitz   6511: dl,
                   6512: ul,
                   6513: div,
                   6514: fieldset {
                   6515:   margin: 10px 10px 10px 0;
                   6516:   /* overflow: hidden; */
1.693     droeschl 6517: }
1.795     www      6518: 
1.838     bisitz   6519: fieldset > legend {
1.911     bisitz   6520:   font-weight: bold;
                   6521:   padding: 0 5px 0 5px;
1.838     bisitz   6522: }
                   6523: 
1.813     bisitz   6524: #LC_nav_bar {
1.911     bisitz   6525:   float: left;
1.995     raeburn  6526:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6527:   margin: 0 0 2px 0;
1.807     droeschl 6528: }
                   6529: 
1.916     droeschl 6530: #LC_realm {
                   6531:   margin: 0.2em 0 0 0;
                   6532:   padding: 0;
                   6533:   font-weight: bold;
                   6534:   text-align: center;
1.995     raeburn  6535:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6536: }
                   6537: 
1.911     bisitz   6538: #LC_nav_bar em {
                   6539:   font-weight: bold;
                   6540:   font-style: normal;
1.807     droeschl 6541: }
                   6542: 
1.897     wenzelju 6543: ol.LC_primary_menu {
1.911     bisitz   6544:   float: right;
1.934     droeschl 6545:   margin: 0;
1.1076    raeburn  6546:   padding: 0;
1.995     raeburn  6547:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6548: }
                   6549: 
1.852     droeschl 6550: ol#LC_PathBreadcrumbs {
1.911     bisitz   6551:   margin: 0;
1.693     droeschl 6552: }
                   6553: 
1.897     wenzelju 6554: ol.LC_primary_menu li {
1.1076    raeburn  6555:   color: RGB(80, 80, 80);
                   6556:   vertical-align: middle;
                   6557:   text-align: left;
                   6558:   list-style: none;
                   6559:   float: left;
                   6560: }
                   6561: 
                   6562: ol.LC_primary_menu li a {
                   6563:   display: block;
                   6564:   margin: 0;
                   6565:   padding: 0 5px 0 10px;
                   6566:   text-decoration: none;
                   6567: }
                   6568: 
                   6569: ol.LC_primary_menu li ul {
                   6570:   display: none;
                   6571:   width: 10em;
                   6572:   background-color: $data_table_light;
                   6573: }
                   6574: 
                   6575: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6576:   display: block;
                   6577:   position: absolute;
                   6578:   margin: 0;
                   6579:   padding: 0;
1.1078    raeburn  6580:   z-index: 2;
1.1076    raeburn  6581: }
                   6582: 
                   6583: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6584:   font-size: 90%;
1.911     bisitz   6585:   vertical-align: top;
1.1076    raeburn  6586:   float: none;
1.1079    raeburn  6587:   border-left: 1px solid black;
                   6588:   border-right: 1px solid black;
1.1076    raeburn  6589: }
                   6590: 
                   6591: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078    raeburn  6592:   background-color:$data_table_light;
1.1076    raeburn  6593: }
                   6594: 
                   6595: ol.LC_primary_menu li li a:hover {
                   6596:    color:$button_hover;
                   6597:    background-color:$data_table_dark;
1.693     droeschl 6598: }
                   6599: 
1.897     wenzelju 6600: ol.LC_primary_menu li img {
1.911     bisitz   6601:   vertical-align: bottom;
1.934     droeschl 6602:   height: 1.1em;
1.1077    raeburn  6603:   margin: 0.2em 0 0 0;
1.693     droeschl 6604: }
                   6605: 
1.897     wenzelju 6606: ol.LC_primary_menu a {
1.911     bisitz   6607:   color: RGB(80, 80, 80);
                   6608:   text-decoration: none;
1.693     droeschl 6609: }
1.795     www      6610: 
1.949     droeschl 6611: ol.LC_primary_menu a.LC_new_message {
                   6612:   font-weight:bold;
                   6613:   color: darkred;
                   6614: }
                   6615: 
1.975     raeburn  6616: ol.LC_docs_parameters {
                   6617:   margin-left: 0;
                   6618:   padding: 0;
                   6619:   list-style: none;
                   6620: }
                   6621: 
                   6622: ol.LC_docs_parameters li {
                   6623:   margin: 0;
                   6624:   padding-right: 20px;
                   6625:   display: inline;
                   6626: }
                   6627: 
1.976     raeburn  6628: ol.LC_docs_parameters li:before {
                   6629:   content: "\\002022 \\0020";
                   6630: }
                   6631: 
                   6632: li.LC_docs_parameters_title {
                   6633:   font-weight: bold;
                   6634: }
                   6635: 
                   6636: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6637:   content: "";
                   6638: }
                   6639: 
1.897     wenzelju 6640: ul#LC_secondary_menu {
1.911     bisitz   6641:   clear: both;
                   6642:   color: $fontmenu;
                   6643:   background: $tabbg;
                   6644:   list-style: none;
                   6645:   padding: 0;
                   6646:   margin: 0;
                   6647:   width: 100%;
1.995     raeburn  6648:   text-align: left;
1.808     droeschl 6649: }
                   6650: 
1.897     wenzelju 6651: ul#LC_secondary_menu li {
1.911     bisitz   6652:   font-weight: bold;
                   6653:   line-height: 1.8em;
                   6654:   padding: 0 0.8em;
                   6655:   border-right: 1px solid black;
                   6656:   display: inline;
                   6657:   vertical-align: middle;
1.807     droeschl 6658: }
                   6659: 
1.847     tempelho 6660: ul.LC_TabContent {
1.911     bisitz   6661:   display:block;
                   6662:   background: $sidebg;
                   6663:   border-bottom: solid 1px $lg_border_color;
                   6664:   list-style:none;
1.1020    raeburn  6665:   margin: -1px -10px 0 -10px;
1.911     bisitz   6666:   padding: 0;
1.693     droeschl 6667: }
                   6668: 
1.795     www      6669: ul.LC_TabContent li,
                   6670: ul.LC_TabContentBigger li {
1.911     bisitz   6671:   float:left;
1.741     harmsja  6672: }
1.795     www      6673: 
1.897     wenzelju 6674: ul#LC_secondary_menu li a {
1.911     bisitz   6675:   color: $fontmenu;
                   6676:   text-decoration: none;
1.693     droeschl 6677: }
1.795     www      6678: 
1.721     harmsja  6679: ul.LC_TabContent {
1.952     onken    6680:   min-height:20px;
1.721     harmsja  6681: }
1.795     www      6682: 
                   6683: ul.LC_TabContent li {
1.911     bisitz   6684:   vertical-align:middle;
1.959     onken    6685:   padding: 0 16px 0 10px;
1.911     bisitz   6686:   background-color:$tabbg;
                   6687:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6688:   border-left: solid 1px $font;
1.721     harmsja  6689: }
1.795     www      6690: 
1.847     tempelho 6691: ul.LC_TabContent .right {
1.911     bisitz   6692:   float:right;
1.847     tempelho 6693: }
                   6694: 
1.911     bisitz   6695: ul.LC_TabContent li a,
                   6696: ul.LC_TabContent li {
                   6697:   color:rgb(47,47,47);
                   6698:   text-decoration:none;
                   6699:   font-size:95%;
                   6700:   font-weight:bold;
1.952     onken    6701:   min-height:20px;
                   6702: }
                   6703: 
1.959     onken    6704: ul.LC_TabContent li a:hover,
                   6705: ul.LC_TabContent li a:focus {
1.952     onken    6706:   color: $button_hover;
1.959     onken    6707:   background:none;
                   6708:   outline:none;
1.952     onken    6709: }
                   6710: 
                   6711: ul.LC_TabContent li:hover {
                   6712:   color: $button_hover;
                   6713:   cursor:pointer;
1.721     harmsja  6714: }
1.795     www      6715: 
1.911     bisitz   6716: ul.LC_TabContent li.active {
1.952     onken    6717:   color: $font;
1.911     bisitz   6718:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6719:   border-bottom:solid 1px #FFFFFF;
                   6720:   cursor: default;
1.744     ehlerst  6721: }
1.795     www      6722: 
1.959     onken    6723: ul.LC_TabContent li.active a {
                   6724:   color:$font;
                   6725:   background:#FFFFFF;
                   6726:   outline: none;
                   6727: }
1.1047    raeburn  6728: 
                   6729: ul.LC_TabContent li.goback {
                   6730:   float: left;
                   6731:   border-left: none;
                   6732: }
                   6733: 
1.870     tempelho 6734: #maincoursedoc {
1.911     bisitz   6735:   clear:both;
1.870     tempelho 6736: }
                   6737: 
                   6738: ul.LC_TabContentBigger {
1.911     bisitz   6739:   display:block;
                   6740:   list-style:none;
                   6741:   padding: 0;
1.870     tempelho 6742: }
                   6743: 
1.795     www      6744: ul.LC_TabContentBigger li {
1.911     bisitz   6745:   vertical-align:bottom;
                   6746:   height: 30px;
                   6747:   font-size:110%;
                   6748:   font-weight:bold;
                   6749:   color: #737373;
1.841     tempelho 6750: }
                   6751: 
1.957     onken    6752: ul.LC_TabContentBigger li.active {
                   6753:   position: relative;
                   6754:   top: 1px;
                   6755: }
                   6756: 
1.870     tempelho 6757: ul.LC_TabContentBigger li a {
1.911     bisitz   6758:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6759:   height: 30px;
                   6760:   line-height: 30px;
                   6761:   text-align: center;
                   6762:   display: block;
                   6763:   text-decoration: none;
1.958     onken    6764:   outline: none;  
1.741     harmsja  6765: }
1.795     www      6766: 
1.870     tempelho 6767: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6768:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6769:   color:$font;
1.744     ehlerst  6770: }
1.795     www      6771: 
1.870     tempelho 6772: ul.LC_TabContentBigger li b {
1.911     bisitz   6773:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6774:   display: block;
                   6775:   float: left;
                   6776:   padding: 0 30px;
1.957     onken    6777:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6778: }
                   6779: 
1.956     onken    6780: ul.LC_TabContentBigger li:hover b {
                   6781:   color:$button_hover;
                   6782: }
                   6783: 
1.870     tempelho 6784: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6785:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6786:   color:$font;
1.957     onken    6787:   border: 0;
1.741     harmsja  6788: }
1.693     droeschl 6789: 
1.870     tempelho 6790: 
1.862     bisitz   6791: ul.LC_CourseBreadcrumbs {
                   6792:   background: $sidebg;
1.1020    raeburn  6793:   height: 2em;
1.862     bisitz   6794:   padding-left: 10px;
1.1020    raeburn  6795:   margin: 0;
1.862     bisitz   6796:   list-style-position: inside;
                   6797: }
                   6798: 
1.911     bisitz   6799: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6800: ol#LC_PathBreadcrumbs {
1.911     bisitz   6801:   padding-left: 10px;
                   6802:   margin: 0;
1.933     droeschl 6803:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6804: }
                   6805: 
1.911     bisitz   6806: ol#LC_MenuBreadcrumbs li,
                   6807: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6808: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6809:   display: inline;
1.933     droeschl 6810:   white-space: normal;  
1.693     droeschl 6811: }
                   6812: 
1.823     bisitz   6813: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6814: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6815:   text-decoration: none;
                   6816:   font-size:90%;
1.693     droeschl 6817: }
1.795     www      6818: 
1.969     droeschl 6819: ol#LC_MenuBreadcrumbs h1 {
                   6820:   display: inline;
                   6821:   font-size: 90%;
                   6822:   line-height: 2.5em;
                   6823:   margin: 0;
                   6824:   padding: 0;
                   6825: }
                   6826: 
1.795     www      6827: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6828:   text-decoration:none;
                   6829:   font-size:100%;
                   6830:   font-weight:bold;
1.693     droeschl 6831: }
1.795     www      6832: 
1.840     bisitz   6833: .LC_Box {
1.911     bisitz   6834:   border: solid 1px $lg_border_color;
                   6835:   padding: 0 10px 10px 10px;
1.746     neumanie 6836: }
1.795     www      6837: 
1.1020    raeburn  6838: .LC_DocsBox {
                   6839:   border: solid 1px $lg_border_color;
                   6840:   padding: 0 0 10px 10px;
                   6841: }
                   6842: 
1.795     www      6843: .LC_AboutMe_Image {
1.911     bisitz   6844:   float:left;
                   6845:   margin-right:10px;
1.747     neumanie 6846: }
1.795     www      6847: 
                   6848: .LC_Clear_AboutMe_Image {
1.911     bisitz   6849:   clear:left;
1.747     neumanie 6850: }
1.795     www      6851: 
1.721     harmsja  6852: dl.LC_ListStyleClean dt {
1.911     bisitz   6853:   padding-right: 5px;
                   6854:   display: table-header-group;
1.693     droeschl 6855: }
                   6856: 
1.721     harmsja  6857: dl.LC_ListStyleClean dd {
1.911     bisitz   6858:   display: table-row;
1.693     droeschl 6859: }
                   6860: 
1.721     harmsja  6861: .LC_ListStyleClean,
                   6862: .LC_ListStyleSimple,
                   6863: .LC_ListStyleNormal,
1.795     www      6864: .LC_ListStyleSpecial {
1.911     bisitz   6865:   /* display:block; */
                   6866:   list-style-position: inside;
                   6867:   list-style-type: none;
                   6868:   overflow: hidden;
                   6869:   padding: 0;
1.693     droeschl 6870: }
                   6871: 
1.721     harmsja  6872: .LC_ListStyleSimple li,
                   6873: .LC_ListStyleSimple dd,
                   6874: .LC_ListStyleNormal li,
                   6875: .LC_ListStyleNormal dd,
                   6876: .LC_ListStyleSpecial li,
1.795     www      6877: .LC_ListStyleSpecial dd {
1.911     bisitz   6878:   margin: 0;
                   6879:   padding: 5px 5px 5px 10px;
                   6880:   clear: both;
1.693     droeschl 6881: }
                   6882: 
1.721     harmsja  6883: .LC_ListStyleClean li,
                   6884: .LC_ListStyleClean dd {
1.911     bisitz   6885:   padding-top: 0;
                   6886:   padding-bottom: 0;
1.693     droeschl 6887: }
                   6888: 
1.721     harmsja  6889: .LC_ListStyleSimple dd,
1.795     www      6890: .LC_ListStyleSimple li {
1.911     bisitz   6891:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6892: }
                   6893: 
1.721     harmsja  6894: .LC_ListStyleSpecial li,
                   6895: .LC_ListStyleSpecial dd {
1.911     bisitz   6896:   list-style-type: none;
                   6897:   background-color: RGB(220, 220, 220);
                   6898:   margin-bottom: 4px;
1.693     droeschl 6899: }
                   6900: 
1.721     harmsja  6901: table.LC_SimpleTable {
1.911     bisitz   6902:   margin:5px;
                   6903:   border:solid 1px $lg_border_color;
1.795     www      6904: }
1.693     droeschl 6905: 
1.721     harmsja  6906: table.LC_SimpleTable tr {
1.911     bisitz   6907:   padding: 0;
                   6908:   border:solid 1px $lg_border_color;
1.693     droeschl 6909: }
1.795     www      6910: 
                   6911: table.LC_SimpleTable thead {
1.911     bisitz   6912:   background:rgb(220,220,220);
1.693     droeschl 6913: }
                   6914: 
1.721     harmsja  6915: div.LC_columnSection {
1.911     bisitz   6916:   display: block;
                   6917:   clear: both;
                   6918:   overflow: hidden;
                   6919:   margin: 0;
1.693     droeschl 6920: }
                   6921: 
1.721     harmsja  6922: div.LC_columnSection>* {
1.911     bisitz   6923:   float: left;
                   6924:   margin: 10px 20px 10px 0;
                   6925:   overflow:hidden;
1.693     droeschl 6926: }
1.721     harmsja  6927: 
1.795     www      6928: table em {
1.911     bisitz   6929:   font-weight: bold;
                   6930:   font-style: normal;
1.748     schulted 6931: }
1.795     www      6932: 
1.779     bisitz   6933: table.LC_tableBrowseRes,
1.795     www      6934: table.LC_tableOfContent {
1.911     bisitz   6935:   border:none;
                   6936:   border-spacing: 1px;
                   6937:   padding: 3px;
                   6938:   background-color: #FFFFFF;
                   6939:   font-size: 90%;
1.753     droeschl 6940: }
1.789     droeschl 6941: 
1.911     bisitz   6942: table.LC_tableOfContent {
                   6943:   border-collapse: collapse;
1.789     droeschl 6944: }
                   6945: 
1.771     droeschl 6946: table.LC_tableBrowseRes a,
1.768     schulted 6947: table.LC_tableOfContent a {
1.911     bisitz   6948:   background-color: transparent;
                   6949:   text-decoration: none;
1.753     droeschl 6950: }
                   6951: 
1.795     www      6952: table.LC_tableOfContent img {
1.911     bisitz   6953:   border: none;
                   6954:   height: 1.3em;
                   6955:   vertical-align: text-bottom;
                   6956:   margin-right: 0.3em;
1.753     droeschl 6957: }
1.757     schulted 6958: 
1.795     www      6959: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6960:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6961: }
                   6962: 
1.795     www      6963: a#LC_content_toolbar_everything {
1.911     bisitz   6964:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6965: }
                   6966: 
1.795     www      6967: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6968:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6969: }
                   6970: 
1.795     www      6971: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6972:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  6973: }
                   6974: 
1.795     www      6975: a#LC_content_toolbar_changefolder {
1.911     bisitz   6976:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 6977: }
                   6978: 
1.795     www      6979: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   6980:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 6981: }
                   6982: 
1.1043    raeburn  6983: a#LC_content_toolbar_edittoplevel {
                   6984:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   6985: }
                   6986: 
1.795     www      6987: ul#LC_toolbar li a:hover {
1.911     bisitz   6988:   background-position: bottom center;
1.757     schulted 6989: }
                   6990: 
1.795     www      6991: ul#LC_toolbar {
1.911     bisitz   6992:   padding: 0;
                   6993:   margin: 2px;
                   6994:   list-style:none;
                   6995:   position:relative;
                   6996:   background-color:white;
1.1082    raeburn  6997:   overflow: auto;
1.757     schulted 6998: }
                   6999: 
1.795     www      7000: ul#LC_toolbar li {
1.911     bisitz   7001:   border:1px solid white;
                   7002:   padding: 0;
                   7003:   margin: 0;
                   7004:   float: left;
                   7005:   display:inline;
                   7006:   vertical-align:middle;
1.1082    raeburn  7007:   white-space: nowrap;
1.911     bisitz   7008: }
1.757     schulted 7009: 
1.783     amueller 7010: 
1.795     www      7011: a.LC_toolbarItem {
1.911     bisitz   7012:   display:block;
                   7013:   padding: 0;
                   7014:   margin: 0;
                   7015:   height: 32px;
                   7016:   width: 32px;
                   7017:   color:white;
                   7018:   border: none;
                   7019:   background-repeat:no-repeat;
                   7020:   background-color:transparent;
1.757     schulted 7021: }
                   7022: 
1.915     droeschl 7023: ul.LC_funclist {
                   7024:     margin: 0;
                   7025:     padding: 0.5em 1em 0.5em 0;
                   7026: }
                   7027: 
1.933     droeschl 7028: ul.LC_funclist > li:first-child {
                   7029:     font-weight:bold; 
                   7030:     margin-left:0.8em;
                   7031: }
                   7032: 
1.915     droeschl 7033: ul.LC_funclist + ul.LC_funclist {
                   7034:     /* 
                   7035:        left border as a seperator if we have more than
                   7036:        one list 
                   7037:     */
                   7038:     border-left: 1px solid $sidebg;
                   7039:     /* 
                   7040:        this hides the left border behind the border of the 
                   7041:        outer box if element is wrapped to the next 'line' 
                   7042:     */
                   7043:     margin-left: -1px;
                   7044: }
                   7045: 
1.843     bisitz   7046: ul.LC_funclist li {
1.915     droeschl 7047:   display: inline;
1.782     bisitz   7048:   white-space: nowrap;
1.915     droeschl 7049:   margin: 0 0 0 25px;
                   7050:   line-height: 150%;
1.782     bisitz   7051: }
                   7052: 
1.974     wenzelju 7053: .LC_hidden {
                   7054:   display: none;
                   7055: }
                   7056: 
1.1030    www      7057: .LCmodal-overlay {
                   7058: 		position:fixed;
                   7059: 		top:0;
                   7060: 		right:0;
                   7061: 		bottom:0;
                   7062: 		left:0;
                   7063: 		height:100%;
                   7064: 		width:100%;
                   7065: 		margin:0;
                   7066: 		padding:0;
                   7067: 		background:#999;
                   7068: 		opacity:.75;
                   7069: 		filter: alpha(opacity=75);
                   7070: 		-moz-opacity: 0.75;
                   7071: 		z-index:101;
                   7072: }
                   7073: 
                   7074: * html .LCmodal-overlay {   
                   7075: 		position: absolute;
                   7076: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7077: }
                   7078: 
                   7079: .LCmodal-window {
                   7080: 		position:fixed;
                   7081: 		top:50%;
                   7082: 		left:50%;
                   7083: 		margin:0;
                   7084: 		padding:0;
                   7085: 		z-index:102;
                   7086: 	}
                   7087: 
                   7088: * html .LCmodal-window {
                   7089: 		position:absolute;
                   7090: }
                   7091: 
                   7092: .LCclose-window {
                   7093: 		position:absolute;
                   7094: 		width:32px;
                   7095: 		height:32px;
                   7096: 		right:8px;
                   7097: 		top:8px;
                   7098: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7099: 		text-indent:-99999px;
                   7100: 		overflow:hidden;
                   7101: 		cursor:pointer;
                   7102: }
                   7103: 
1.343     albertel 7104: END
                   7105: }
                   7106: 
1.306     albertel 7107: =pod
                   7108: 
                   7109: =item * &headtag()
                   7110: 
                   7111: Returns a uniform footer for LON-CAPA web pages.
                   7112: 
1.307     albertel 7113: Inputs: $title - optional title for the head
                   7114:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7115:         $args - optional arguments
1.319     albertel 7116:             force_register - if is true call registerurl so the remote is 
                   7117:                              informed
1.415     albertel 7118:             redirect       -> array ref of
                   7119:                                    1- seconds before redirect occurs
                   7120:                                    2- url to redirect to
                   7121:                                    3- whether the side effect should occur
1.315     albertel 7122:                            (side effect of setting 
                   7123:                                $env{'internal.head.redirect'} to the url 
                   7124:                                redirected too)
1.352     albertel 7125:             domain         -> force to color decorate a page for a specific
                   7126:                                domain
                   7127:             function       -> force usage of a specific rolish color scheme
                   7128:             bgcolor        -> override the default page bgcolor
1.460     albertel 7129:             no_auto_mt_title
                   7130:                            -> prevent &mt()ing the title arg
1.464     albertel 7131: 
1.306     albertel 7132: =cut
                   7133: 
                   7134: sub headtag {
1.313     albertel 7135:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7136:     
1.363     albertel 7137:     my $function = $args->{'function'} || &get_users_function();
                   7138:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7139:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7140:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7141: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7142: 		   #time(),
1.418     albertel 7143: 		   $env{'environment.color.timestamp'},
1.363     albertel 7144: 		   $function,$domain,$bgcolor);
                   7145: 
1.369     www      7146:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7147: 
1.308     albertel 7148:     my $result =
                   7149: 	'<head>'.
1.461     albertel 7150: 	&font_settings();
1.319     albertel 7151: 
1.1064    raeburn  7152:     my $inhibitprint = &print_suppression();
                   7153: 
1.461     albertel 7154:     if (!$args->{'frameset'}) {
                   7155: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7156:     }
1.962     droeschl 7157:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7158:         $result .= Apache::lonxml::display_title();
1.319     albertel 7159:     }
1.436     albertel 7160:     if (!$args->{'no_nav_bar'} 
                   7161: 	&& !$args->{'only_body'}
                   7162: 	&& !$args->{'frameset'}) {
                   7163: 	$result .= &help_menu_js();
1.1032    www      7164:         $result.=&modal_window();
1.1038    www      7165:         $result.=&togglebox_script();
1.1034    www      7166:         $result.=&wishlist_window();
1.1041    www      7167:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7168:     } else {
                   7169:         if ($args->{'add_modal'}) {
                   7170:            $result.=&modal_window();
                   7171:         }
                   7172:         if ($args->{'add_wishlist'}) {
                   7173:            $result.=&wishlist_window();
                   7174:         }
1.1038    www      7175:         if ($args->{'add_togglebox'}) {
                   7176:            $result.=&togglebox_script();
                   7177:         }
1.1041    www      7178:         if ($args->{'add_progressbar'}) {
                   7179:            $result.=&LCprogressbarUpdate_script();
                   7180:         }
1.436     albertel 7181:     }
1.314     albertel 7182:     if (ref($args->{'redirect'})) {
1.414     albertel 7183: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7184: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7185: 	if (!$inhibit_continue) {
                   7186: 	    $env{'internal.head.redirect'} = $url;
                   7187: 	}
1.313     albertel 7188: 	$result.=<<ADDMETA
                   7189: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7190: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7191: ADDMETA
                   7192:     }
1.306     albertel 7193:     if (!defined($title)) {
                   7194: 	$title = 'The LearningOnline Network with CAPA';
                   7195:     }
1.460     albertel 7196:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7197:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7198: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7199:         .$inhibitprint
1.414     albertel 7200: 	.$head_extra;
1.962     droeschl 7201:     return $result.'</head>';
1.306     albertel 7202: }
                   7203: 
                   7204: =pod
                   7205: 
1.340     albertel 7206: =item * &font_settings()
                   7207: 
                   7208: Returns neccessary <meta> to set the proper encoding
                   7209: 
                   7210: Inputs: none
                   7211: 
                   7212: =cut
                   7213: 
                   7214: sub font_settings {
                   7215:     my $headerstring='';
1.647     www      7216:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7217: 	$headerstring.=
                   7218: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7219:     }
                   7220:     return $headerstring;
                   7221: }
                   7222: 
1.341     albertel 7223: =pod
                   7224: 
1.1064    raeburn  7225: =item * &print_suppression()
                   7226: 
                   7227: In course context returns css which causes the body to be blank when media="print",
                   7228: if printout generation is unavailable for the current resource.
                   7229: 
                   7230: This could be because:
                   7231: 
                   7232: (a) printstartdate is in the future
                   7233: 
                   7234: (b) printenddate is in the past
                   7235: 
                   7236: (c) there is an active exam block with "printout"
                   7237: functionality blocked
                   7238: 
                   7239: Users with pav, pfo or evb privileges are exempt.
                   7240: 
                   7241: Inputs: none
                   7242: 
                   7243: =cut
                   7244: 
                   7245: 
                   7246: sub print_suppression {
                   7247:     my $noprint;
                   7248:     if ($env{'request.course.id'}) {
                   7249:         my $scope = $env{'request.course.id'};
                   7250:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7251:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7252:             return;
                   7253:         }
                   7254:         if ($env{'request.course.sec'} ne '') {
                   7255:             $scope .= "/$env{'request.course.sec'}";
                   7256:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7257:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7258:                 return;
1.1064    raeburn  7259:             }
                   7260:         }
                   7261:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7262:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7263:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7264:         if ($blocked) {
                   7265:             my $checkrole = "cm./$cdom/$cnum";
                   7266:             if ($env{'request.course.sec'} ne '') {
                   7267:                 $checkrole .= "/$env{'request.course.sec'}";
                   7268:             }
                   7269:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7270:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7271:                 $noprint = 1;
                   7272:             }
                   7273:         }
                   7274:         unless ($noprint) {
                   7275:             my $symb = &Apache::lonnet::symbread();
                   7276:             if ($symb ne '') {
                   7277:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7278:                 if (ref($navmap)) {
                   7279:                     my $res = $navmap->getBySymb($symb);
                   7280:                     if (ref($res)) {
                   7281:                         if (!$res->resprintable()) {
                   7282:                             $noprint = 1;
                   7283:                         }
                   7284:                     }
                   7285:                 }
                   7286:             }
                   7287:         }
                   7288:         if ($noprint) {
                   7289:             return <<"ENDSTYLE";
                   7290: <style type="text/css" media="print">
                   7291:     body { display:none }
                   7292: </style>
                   7293: ENDSTYLE
                   7294:         }
                   7295:     }
                   7296:     return;
                   7297: }
                   7298: 
                   7299: =pod
                   7300: 
1.341     albertel 7301: =item * &xml_begin()
                   7302: 
                   7303: Returns the needed doctype and <html>
                   7304: 
                   7305: Inputs: none
                   7306: 
                   7307: =cut
                   7308: 
                   7309: sub xml_begin {
                   7310:     my $output='';
                   7311: 
                   7312:     if ($env{'browser.mathml'}) {
                   7313: 	$output='<?xml version="1.0"?>'
                   7314:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7315: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7316:             
                   7317: #	    .'<!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">] >'
                   7318: 	    .'<!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">'
                   7319:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7320: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7321:     } else {
1.849     bisitz   7322: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7323:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7324:     }
                   7325:     return $output;
                   7326: }
1.340     albertel 7327: 
                   7328: =pod
                   7329: 
1.306     albertel 7330: =item * &start_page()
                   7331: 
                   7332: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7333: 
1.648     raeburn  7334: Inputs:
                   7335: 
                   7336: =over 4
                   7337: 
                   7338: $title - optional title for the page
                   7339: 
                   7340: $head_extra - optional extra HTML to incude inside the <head>
                   7341: 
                   7342: $args - additional optional args supported are:
                   7343: 
                   7344: =over 8
                   7345: 
                   7346:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7347:                                     arg on
1.814     bisitz   7348:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7349:              add_entries    -> additional attributes to add to the  <body>
                   7350:              domain         -> force to color decorate a page for a 
1.317     albertel 7351:                                     specific domain
1.648     raeburn  7352:              function       -> force usage of a specific rolish color
1.317     albertel 7353:                                     scheme
1.648     raeburn  7354:              redirect       -> see &headtag()
                   7355:              bgcolor        -> override the default page bg color
                   7356:              js_ready       -> return a string ready for being used in 
1.317     albertel 7357:                                     a javascript writeln
1.648     raeburn  7358:              html_encode    -> return a string ready for being used in 
1.320     albertel 7359:                                     a html attribute
1.648     raeburn  7360:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7361:                                     $forcereg arg
1.648     raeburn  7362:              frameset       -> if true will start with a <frameset>
1.330     albertel 7363:                                     rather than <body>
1.648     raeburn  7364:              skip_phases    -> hash ref of 
1.338     albertel 7365:                                     head -> skip the <html><head> generation
                   7366:                                     body -> skip all <body> generation
1.648     raeburn  7367:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7368:              inherit_jsmath -> when creating popup window in a page,
                   7369:                                     should it have jsmath forced on by the
                   7370:                                     current page
1.867     kalberla 7371:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7372:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 7373: 
1.648     raeburn  7374: =back
1.460     albertel 7375: 
1.648     raeburn  7376: =back
1.562     albertel 7377: 
1.306     albertel 7378: =cut
                   7379: 
                   7380: sub start_page {
1.309     albertel 7381:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7382:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7383: 
1.315     albertel 7384:     $env{'internal.start_page'}++;
1.338     albertel 7385:     my $result;
1.964     droeschl 7386: 
1.338     albertel 7387:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7388:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7389:     }
                   7390:     
                   7391:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7392: 	if ($args->{'frameset'}) {
                   7393: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7394: 						$args->{'add_entries'});
                   7395: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7396:         } else {
                   7397:             $result .=
                   7398:                 &bodytag($title, 
                   7399:                          $args->{'function'},       $args->{'add_entries'},
                   7400:                          $args->{'only_body'},      $args->{'domain'},
                   7401:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.962     droeschl 7402:                          $args->{'bgcolor'},        $args);
1.831     bisitz   7403:         }
1.330     albertel 7404:     }
1.338     albertel 7405: 
1.315     albertel 7406:     if ($args->{'js_ready'}) {
1.713     kaisler  7407: 		$result = &js_ready($result);
1.315     albertel 7408:     }
1.320     albertel 7409:     if ($args->{'html_encode'}) {
1.713     kaisler  7410: 		$result = &html_encode($result);
                   7411:     }
                   7412: 
1.813     bisitz   7413:     # Preparation for new and consistent functionlist at top of screen
                   7414:     # if ($args->{'functionlist'}) {
                   7415:     #            $result .= &build_functionlist();
                   7416:     #}
                   7417: 
1.964     droeschl 7418:     # Don't add anything more if only_body wanted or in const space
                   7419:     return $result if    $args->{'only_body'} 
                   7420:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7421: 
                   7422:     #Breadcrumbs
1.758     kaisler  7423:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7424: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7425: 		#if any br links exists, add them to the breadcrumbs
                   7426: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7427: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7428: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7429: 			}
                   7430: 		}
                   7431: 
                   7432: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7433: 		if(exists($args->{'bread_crumbs_component'})){
                   7434: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7435: 		}else{
                   7436: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7437: 		}
1.320     albertel 7438:     }
1.315     albertel 7439:     return $result;
1.306     albertel 7440: }
                   7441: 
                   7442: sub end_page {
1.315     albertel 7443:     my ($args) = @_;
                   7444:     $env{'internal.end_page'}++;
1.330     albertel 7445:     my $result;
1.335     albertel 7446:     if ($args->{'discussion'}) {
                   7447: 	my ($target,$parser);
                   7448: 	if (ref($args->{'discussion'})) {
                   7449: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7450: 				$args->{'discussion'}{'parser'});
                   7451: 	}
                   7452: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7453:     }
1.330     albertel 7454:     if ($args->{'frameset'}) {
                   7455: 	$result .= '</frameset>';
                   7456:     } else {
1.635     raeburn  7457: 	$result .= &endbodytag($args);
1.330     albertel 7458:     }
1.1080    raeburn  7459:     unless ($args->{'notbody'}) {
                   7460:         $result .= "\n</html>";
                   7461:     }
1.330     albertel 7462: 
1.315     albertel 7463:     if ($args->{'js_ready'}) {
1.317     albertel 7464: 	$result = &js_ready($result);
1.315     albertel 7465:     }
1.335     albertel 7466: 
1.320     albertel 7467:     if ($args->{'html_encode'}) {
                   7468: 	$result = &html_encode($result);
                   7469:     }
1.335     albertel 7470: 
1.315     albertel 7471:     return $result;
                   7472: }
                   7473: 
1.1034    www      7474: sub wishlist_window {
                   7475:     return(<<'ENDWISHLIST');
1.1046    raeburn  7476: <script type="text/javascript">
1.1034    www      7477: // <![CDATA[
                   7478: // <!-- BEGIN LON-CAPA Internal
                   7479: function set_wishlistlink(title, path) {
                   7480:     if (!title) {
                   7481:         title = document.title;
                   7482:         title = title.replace(/^LON-CAPA /,'');
                   7483:     }
                   7484:     if (!path) {
                   7485:         path = location.pathname;
                   7486:     }
                   7487:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7488:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7489: }
                   7490: // END LON-CAPA Internal -->
                   7491: // ]]>
                   7492: </script>
                   7493: ENDWISHLIST
                   7494: }
                   7495: 
1.1030    www      7496: sub modal_window {
                   7497:     return(<<'ENDMODAL');
1.1046    raeburn  7498: <script type="text/javascript">
1.1030    www      7499: // <![CDATA[
                   7500: // <!-- BEGIN LON-CAPA Internal
                   7501: var modalWindow = {
                   7502: 	parent:"body",
                   7503: 	windowId:null,
                   7504: 	content:null,
                   7505: 	width:null,
                   7506: 	height:null,
                   7507: 	close:function()
                   7508: 	{
                   7509: 	        $(".LCmodal-window").remove();
                   7510: 	        $(".LCmodal-overlay").remove();
                   7511: 	},
                   7512: 	open:function()
                   7513: 	{
                   7514: 		var modal = "";
                   7515: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7516: 		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;\">";
                   7517: 		modal += this.content;
                   7518: 		modal += "</div>";	
                   7519: 
                   7520: 		$(this.parent).append(modal);
                   7521: 
                   7522: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7523: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7524: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7525: 	}
                   7526: };
1.1031    www      7527: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7528: 	{
                   7529: 		modalWindow.windowId = "myModal";
                   7530: 		modalWindow.width = width;
                   7531: 		modalWindow.height = height;
1.1031    www      7532: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7533: 		modalWindow.open();
                   7534: 	};	
                   7535: // END LON-CAPA Internal -->
                   7536: // ]]>
                   7537: </script>
                   7538: ENDMODAL
                   7539: }
                   7540: 
                   7541: sub modal_link {
1.1052    www      7542:     my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030    www      7543:     unless ($width) { $width=480; }
                   7544:     unless ($height) { $height=400; }
1.1031    www      7545:     unless ($scrolling) { $scrolling='yes'; }
1.1074    raeburn  7546:     my $target_attr;
                   7547:     if (defined($target)) {
                   7548:         $target_attr = 'target="'.$target.'"';
                   7549:     }
                   7550:     return <<"ENDLINK";
                   7551: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
                   7552:            $linktext</a>
                   7553: ENDLINK
1.1030    www      7554: }
                   7555: 
1.1032    www      7556: sub modal_adhoc_script {
                   7557:     my ($funcname,$width,$height,$content)=@_;
                   7558:     return (<<ENDADHOC);
1.1046    raeburn  7559: <script type="text/javascript">
1.1032    www      7560: // <![CDATA[
                   7561:         var $funcname = function()
                   7562:         {
                   7563:                 modalWindow.windowId = "myModal";
                   7564:                 modalWindow.width = $width;
                   7565:                 modalWindow.height = $height;
                   7566:                 modalWindow.content = '$content';
                   7567:                 modalWindow.open();
                   7568:         };  
                   7569: // ]]>
                   7570: </script>
                   7571: ENDADHOC
                   7572: }
                   7573: 
1.1041    www      7574: sub modal_adhoc_inner {
                   7575:     my ($funcname,$width,$height,$content)=@_;
                   7576:     my $innerwidth=$width-20;
                   7577:     $content=&js_ready(
1.1042    www      7578:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041    www      7579:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
                   7580:                     $content.
                   7581:                  &end_scrollbox().
                   7582:                &end_page()
                   7583:              );
                   7584:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7585: }
                   7586: 
                   7587: sub modal_adhoc_window {
                   7588:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7589:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7590:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7591: }
                   7592: 
                   7593: sub modal_adhoc_launch {
                   7594:     my ($funcname,$width,$height,$content)=@_;
                   7595:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7596: <script type="text/javascript">
                   7597: // <![CDATA[
                   7598: $funcname();
                   7599: // ]]>
                   7600: </script>
                   7601: ENDLAUNCH
                   7602: }
                   7603: 
                   7604: sub modal_adhoc_close {
                   7605:     return (<<ENDCLOSE);
                   7606: <script type="text/javascript">
                   7607: // <![CDATA[
                   7608: modalWindow.close();
                   7609: // ]]>
                   7610: </script>
                   7611: ENDCLOSE
                   7612: }
                   7613: 
1.1038    www      7614: sub togglebox_script {
                   7615:    return(<<ENDTOGGLE);
                   7616: <script type="text/javascript"> 
                   7617: // <![CDATA[
                   7618: function LCtoggleDisplay(id,hidetext,showtext) {
                   7619:    link = document.getElementById(id + "link").childNodes[0];
                   7620:    with (document.getElementById(id).style) {
                   7621:       if (display == "none" ) {
                   7622:           display = "inline";
                   7623:           link.nodeValue = hidetext;
                   7624:         } else {
                   7625:           display = "none";
                   7626:           link.nodeValue = showtext;
                   7627:        }
                   7628:    }
                   7629: }
                   7630: // ]]>
                   7631: </script>
                   7632: ENDTOGGLE
                   7633: }
                   7634: 
1.1039    www      7635: sub start_togglebox {
                   7636:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7637:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7638:     unless ($showtext) { $showtext=&mt('show'); }
                   7639:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7640:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7641:     return &start_data_table().
                   7642:            &start_data_table_header_row().
                   7643:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7644:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7645:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7646:            &end_data_table_header_row().
                   7647:            '<tr id="'.$id.'" style="display:none""><td>';
                   7648: }
                   7649: 
                   7650: sub end_togglebox {
                   7651:     return '</td></tr>'.&end_data_table();
                   7652: }
                   7653: 
1.1041    www      7654: sub LCprogressbar_script {
1.1045    www      7655:    my ($id)=@_;
1.1041    www      7656:    return(<<ENDPROGRESS);
                   7657: <script type="text/javascript">
                   7658: // <![CDATA[
1.1045    www      7659: \$('#progressbar$id').progressbar({
1.1041    www      7660:   value: 0,
                   7661:   change: function(event, ui) {
                   7662:     var newVal = \$(this).progressbar('option', 'value');
                   7663:     \$('.pblabel', this).text(LCprogressTxt);
                   7664:   }
                   7665: });
                   7666: // ]]>
                   7667: </script>
                   7668: ENDPROGRESS
                   7669: }
                   7670: 
                   7671: sub LCprogressbarUpdate_script {
                   7672:    return(<<ENDPROGRESSUPDATE);
                   7673: <style type="text/css">
                   7674: .ui-progressbar { position:relative; }
                   7675: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7676: </style>
                   7677: <script type="text/javascript">
                   7678: // <![CDATA[
1.1045    www      7679: var LCprogressTxt='---';
                   7680: 
                   7681: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7682:    LCprogressTxt=progresstext;
1.1045    www      7683:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7684: }
                   7685: // ]]>
                   7686: </script>
                   7687: ENDPROGRESSUPDATE
                   7688: }
                   7689: 
1.1042    www      7690: my $LClastpercent;
1.1045    www      7691: my $LCidcnt;
                   7692: my $LCcurrentid;
1.1042    www      7693: 
1.1041    www      7694: sub LCprogressbar {
1.1042    www      7695:     my ($r)=(@_);
                   7696:     $LClastpercent=0;
1.1045    www      7697:     $LCidcnt++;
                   7698:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7699:     my $starting=&mt('Starting');
                   7700:     my $content=(<<ENDPROGBAR);
                   7701: <p>
1.1045    www      7702:   <div id="progressbar$LCcurrentid">
1.1041    www      7703:     <span class="pblabel">$starting</span>
                   7704:   </div>
                   7705: </p>
                   7706: ENDPROGBAR
1.1045    www      7707:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7708: }
                   7709: 
                   7710: sub LCprogressbarUpdate {
1.1042    www      7711:     my ($r,$val,$text)=@_;
                   7712:     unless ($val) { 
                   7713:        if ($LClastpercent) {
                   7714:            $val=$LClastpercent;
                   7715:        } else {
                   7716:            $val=0;
                   7717:        }
                   7718:     }
1.1041    www      7719:     if ($val<0) { $val=0; }
                   7720:     if ($val>100) { $val=0; }
1.1042    www      7721:     $LClastpercent=$val;
1.1041    www      7722:     unless ($text) { $text=$val.'%'; }
                   7723:     $text=&js_ready($text);
1.1044    www      7724:     &r_print($r,<<ENDUPDATE);
1.1041    www      7725: <script type="text/javascript">
                   7726: // <![CDATA[
1.1045    www      7727: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7728: // ]]>
                   7729: </script>
                   7730: ENDUPDATE
1.1035    www      7731: }
                   7732: 
1.1042    www      7733: sub LCprogressbarClose {
                   7734:     my ($r)=@_;
                   7735:     $LClastpercent=0;
1.1044    www      7736:     &r_print($r,<<ENDCLOSE);
1.1042    www      7737: <script type="text/javascript">
                   7738: // <![CDATA[
1.1045    www      7739: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7740: // ]]>
                   7741: </script>
                   7742: ENDCLOSE
1.1044    www      7743: }
                   7744: 
                   7745: sub r_print {
                   7746:     my ($r,$to_print)=@_;
                   7747:     if ($r) {
                   7748:       $r->print($to_print);
                   7749:       $r->rflush();
                   7750:     } else {
                   7751:       print($to_print);
                   7752:     }
1.1042    www      7753: }
                   7754: 
1.320     albertel 7755: sub html_encode {
                   7756:     my ($result) = @_;
                   7757: 
1.322     albertel 7758:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7759:     
                   7760:     return $result;
                   7761: }
1.1044    www      7762: 
1.317     albertel 7763: sub js_ready {
                   7764:     my ($result) = @_;
                   7765: 
1.323     albertel 7766:     $result =~ s/[\n\r]/ /xmsg;
                   7767:     $result =~ s/\\/\\\\/xmsg;
                   7768:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7769:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7770:     
                   7771:     return $result;
                   7772: }
                   7773: 
1.315     albertel 7774: sub validate_page {
                   7775:     if (  exists($env{'internal.start_page'})
1.316     albertel 7776: 	  &&     $env{'internal.start_page'} > 1) {
                   7777: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7778: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7779: 				 $ENV{'request.filename'});
1.315     albertel 7780:     }
                   7781:     if (  exists($env{'internal.end_page'})
1.316     albertel 7782: 	  &&     $env{'internal.end_page'} > 1) {
                   7783: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7784: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7785: 				 $env{'request.filename'});
1.315     albertel 7786:     }
                   7787:     if (     exists($env{'internal.start_page'})
                   7788: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7789: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7790: 				 $env{'request.filename'});
1.315     albertel 7791:     }
                   7792:     if (   ! exists($env{'internal.start_page'})
                   7793: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7794: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7795: 				 $env{'request.filename'});
1.315     albertel 7796:     }
1.306     albertel 7797: }
1.315     albertel 7798: 
1.996     www      7799: 
                   7800: sub start_scrollbox {
1.1075    raeburn  7801:     my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998     raeburn  7802:     unless ($outerwidth) { $outerwidth='520px'; }
                   7803:     unless ($width) { $width='500px'; }
                   7804:     unless ($height) { $height='200px'; }
1.1075    raeburn  7805:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7806:     if ($id ne '') {
1.1020    raeburn  7807:         $table_id = " id='table_$id'";
                   7808:         $div_id = " id='div_$id'";
1.1018    raeburn  7809:     }
1.1075    raeburn  7810:     if ($bgcolor ne '') {
                   7811:         $tdcol = "background-color: $bgcolor;";
                   7812:     }
                   7813:     return <<"END";
                   7814: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol"><div style="overflow:auto; width:$width; height: $height;"$div_id>
                   7815: END
1.996     www      7816: }
                   7817: 
                   7818: sub end_scrollbox {
1.1036    www      7819:     return '</div></td></tr></table>';
1.996     www      7820: }
                   7821: 
1.318     albertel 7822: sub simple_error_page {
                   7823:     my ($r,$title,$msg) = @_;
                   7824:     my $page =
                   7825: 	&Apache::loncommon::start_page($title).
                   7826: 	&mt($msg).
                   7827: 	&Apache::loncommon::end_page();
                   7828:     if (ref($r)) {
                   7829: 	$r->print($page);
1.327     albertel 7830: 	return;
1.318     albertel 7831:     }
                   7832:     return $page;
                   7833: }
1.347     albertel 7834: 
                   7835: {
1.610     albertel 7836:     my @row_count;
1.961     onken    7837: 
                   7838:     sub start_data_table_count {
                   7839:         unshift(@row_count, 0);
                   7840:         return;
                   7841:     }
                   7842: 
                   7843:     sub end_data_table_count {
                   7844:         shift(@row_count);
                   7845:         return;
                   7846:     }
                   7847: 
1.347     albertel 7848:     sub start_data_table {
1.1018    raeburn  7849: 	my ($add_class,$id) = @_;
1.422     albertel 7850: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7851:         my $table_id;
                   7852:         if (defined($id)) {
                   7853:             $table_id = ' id="'.$id.'"';
                   7854:         }
1.961     onken    7855: 	&start_data_table_count();
1.1018    raeburn  7856: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7857:     }
                   7858: 
                   7859:     sub end_data_table {
1.961     onken    7860: 	&end_data_table_count();
1.389     albertel 7861: 	return '</table>'."\n";;
1.347     albertel 7862:     }
                   7863: 
                   7864:     sub start_data_table_row {
1.974     wenzelju 7865: 	my ($add_class, $id) = @_;
1.610     albertel 7866: 	$row_count[0]++;
                   7867: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7868: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7869:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7870:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7871:     }
1.471     banghart 7872:     
                   7873:     sub continue_data_table_row {
1.974     wenzelju 7874: 	my ($add_class, $id) = @_;
1.610     albertel 7875: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7876: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7877:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7878:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7879:     }
1.347     albertel 7880: 
                   7881:     sub end_data_table_row {
1.389     albertel 7882: 	return '</tr>'."\n";;
1.347     albertel 7883:     }
1.367     www      7884: 
1.421     albertel 7885:     sub start_data_table_empty_row {
1.707     bisitz   7886: #	$row_count[0]++;
1.421     albertel 7887: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7888:     }
                   7889: 
                   7890:     sub end_data_table_empty_row {
                   7891: 	return '</tr>'."\n";;
                   7892:     }
                   7893: 
1.367     www      7894:     sub start_data_table_header_row {
1.389     albertel 7895: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7896:     }
                   7897: 
                   7898:     sub end_data_table_header_row {
1.389     albertel 7899: 	return '</tr>'."\n";;
1.367     www      7900:     }
1.890     droeschl 7901: 
                   7902:     sub data_table_caption {
                   7903:         my $caption = shift;
                   7904:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7905:     }
1.347     albertel 7906: }
                   7907: 
1.548     albertel 7908: =pod
                   7909: 
                   7910: =item * &inhibit_menu_check($arg)
                   7911: 
                   7912: Checks for a inhibitmenu state and generates output to preserve it
                   7913: 
                   7914: Inputs:         $arg - can be any of
                   7915:                      - undef - in which case the return value is a string 
                   7916:                                to add  into arguments list of a uri
                   7917:                      - 'input' - in which case the return value is a HTML
                   7918:                                  <form> <input> field of type hidden to
                   7919:                                  preserve the value
                   7920:                      - a url - in which case the return value is the url with
                   7921:                                the neccesary cgi args added to preserve the
                   7922:                                inhibitmenu state
                   7923:                      - a ref to a url - no return value, but the string is
                   7924:                                         updated to include the neccessary cgi
                   7925:                                         args to preserve the inhibitmenu state
                   7926: 
                   7927: =cut
                   7928: 
                   7929: sub inhibit_menu_check {
                   7930:     my ($arg) = @_;
                   7931:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7932:     if ($arg eq 'input') {
                   7933: 	if ($env{'form.inhibitmenu'}) {
                   7934: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7935: 	} else {
                   7936: 	    return
                   7937: 	}
                   7938:     }
                   7939:     if ($env{'form.inhibitmenu'}) {
                   7940: 	if (ref($arg)) {
                   7941: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7942: 	} elsif ($arg eq '') {
                   7943: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7944: 	} else {
                   7945: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7946: 	}
                   7947:     }
                   7948:     if (!ref($arg)) {
                   7949: 	return $arg;
                   7950:     }
                   7951: }
                   7952: 
1.251     albertel 7953: ###############################################
1.182     matthew  7954: 
                   7955: =pod
                   7956: 
1.549     albertel 7957: =back
                   7958: 
                   7959: =head1 User Information Routines
                   7960: 
                   7961: =over 4
                   7962: 
1.405     albertel 7963: =item * &get_users_function()
1.182     matthew  7964: 
                   7965: Used by &bodytag to determine the current users primary role.
                   7966: Returns either 'student','coordinator','admin', or 'author'.
                   7967: 
                   7968: =cut
                   7969: 
                   7970: ###############################################
                   7971: sub get_users_function {
1.815     tempelho 7972:     my $function = 'norole';
1.818     tempelho 7973:     if ($env{'request.role'}=~/^(st)/) {
                   7974:         $function='student';
                   7975:     }
1.907     raeburn  7976:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7977:         $function='coordinator';
                   7978:     }
1.258     albertel 7979:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7980:         $function='admin';
                   7981:     }
1.826     bisitz   7982:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  7983:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  7984:         $function='author';
                   7985:     }
                   7986:     return $function;
1.54      www      7987: }
1.99      www      7988: 
                   7989: ###############################################
                   7990: 
1.233     raeburn  7991: =pod
                   7992: 
1.821     raeburn  7993: =item * &show_course()
                   7994: 
                   7995: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7996: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7997: 
                   7998: Inputs:
                   7999: None
                   8000: 
                   8001: Outputs:
                   8002: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8003: 
                   8004: =cut
                   8005: 
                   8006: ###############################################
                   8007: sub show_course {
                   8008:     my $course = !$env{'user.adv'};
                   8009:     if (!$env{'user.adv'}) {
                   8010:         foreach my $env (keys(%env)) {
                   8011:             next if ($env !~ m/^user\.priv\./);
                   8012:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8013:                 $course = 0;
                   8014:                 last;
                   8015:             }
                   8016:         }
                   8017:     }
                   8018:     return $course;
                   8019: }
                   8020: 
                   8021: ###############################################
                   8022: 
                   8023: =pod
                   8024: 
1.542     raeburn  8025: =item * &check_user_status()
1.274     raeburn  8026: 
                   8027: Determines current status of supplied role for a
                   8028: specific user. Roles can be active, previous or future.
                   8029: 
                   8030: Inputs: 
                   8031: user's domain, user's username, course's domain,
1.375     raeburn  8032: course's number, optional section ID.
1.274     raeburn  8033: 
                   8034: Outputs:
                   8035: role status: active, previous or future. 
                   8036: 
                   8037: =cut
                   8038: 
                   8039: sub check_user_status {
1.412     raeburn  8040:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8041:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8042:     my @uroles = keys %userinfo;
                   8043:     my $srchstr;
                   8044:     my $active_chk = 'none';
1.412     raeburn  8045:     my $now = time;
1.274     raeburn  8046:     if (@uroles > 0) {
1.908     raeburn  8047:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8048:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8049:         } else {
1.412     raeburn  8050:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8051:         }
                   8052:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8053:             my $role_end = 0;
                   8054:             my $role_start = 0;
                   8055:             $active_chk = 'active';
1.412     raeburn  8056:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8057:                 $role_end = $1;
                   8058:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8059:                     $role_start = $1;
1.274     raeburn  8060:                 }
                   8061:             }
                   8062:             if ($role_start > 0) {
1.412     raeburn  8063:                 if ($now < $role_start) {
1.274     raeburn  8064:                     $active_chk = 'future';
                   8065:                 }
                   8066:             }
                   8067:             if ($role_end > 0) {
1.412     raeburn  8068:                 if ($now > $role_end) {
1.274     raeburn  8069:                     $active_chk = 'previous';
                   8070:                 }
                   8071:             }
                   8072:         }
                   8073:     }
                   8074:     return $active_chk;
                   8075: }
                   8076: 
                   8077: ###############################################
                   8078: 
                   8079: =pod
                   8080: 
1.405     albertel 8081: =item * &get_sections()
1.233     raeburn  8082: 
                   8083: Determines all the sections for a course including
                   8084: sections with students and sections containing other roles.
1.419     raeburn  8085: Incoming parameters: 
                   8086: 
                   8087: 1. domain
                   8088: 2. course number 
                   8089: 3. reference to array containing roles for which sections should 
                   8090: be gathered (optional).
                   8091: 4. reference to array containing status types for which sections 
                   8092: should be gathered (optional).
                   8093: 
                   8094: If the third argument is undefined, sections are gathered for any role. 
                   8095: If the fourth argument is undefined, sections are gathered for any status.
                   8096: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8097:  
1.374     raeburn  8098: Returns section hash (keys are section IDs, values are
                   8099: number of users in each section), subject to the
1.419     raeburn  8100: optional roles filter, optional status filter 
1.233     raeburn  8101: 
                   8102: =cut
                   8103: 
                   8104: ###############################################
                   8105: sub get_sections {
1.419     raeburn  8106:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8107:     if (!defined($cdom) || !defined($cnum)) {
                   8108:         my $cid =  $env{'request.course.id'};
                   8109: 
                   8110: 	return if (!defined($cid));
                   8111: 
                   8112:         $cdom = $env{'course.'.$cid.'.domain'};
                   8113:         $cnum = $env{'course.'.$cid.'.num'};
                   8114:     }
                   8115: 
                   8116:     my %sectioncount;
1.419     raeburn  8117:     my $now = time;
1.240     albertel 8118: 
1.366     albertel 8119:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 8120: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8121: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8122: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8123:         my $start_index = &Apache::loncoursedata::CL_START();
                   8124:         my $end_index = &Apache::loncoursedata::CL_END();
                   8125:         my $status;
1.366     albertel 8126: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8127: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8128: 				                     $data->[$status_index],
                   8129:                                                      $data->[$start_index],
                   8130:                                                      $data->[$end_index]);
                   8131:             if ($stu_status eq 'Active') {
                   8132:                 $status = 'active';
                   8133:             } elsif ($end < $now) {
                   8134:                 $status = 'previous';
                   8135:             } elsif ($start > $now) {
                   8136:                 $status = 'future';
                   8137:             } 
                   8138: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8139:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8140:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8141: 		    $sectioncount{$section}++;
                   8142:                 }
1.240     albertel 8143: 	    }
                   8144: 	}
                   8145:     }
                   8146:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8147:     foreach my $user (sort(keys(%courseroles))) {
                   8148: 	if ($user !~ /^(\w{2})/) { next; }
                   8149: 	my ($role) = ($user =~ /^(\w{2})/);
                   8150: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8151: 	my ($section,$status);
1.240     albertel 8152: 	if ($role eq 'cr' &&
                   8153: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8154: 	    $section=$1;
                   8155: 	}
                   8156: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8157: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8158:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8159:         if ($end == -1 && $start == -1) {
                   8160:             next; #deleted role
                   8161:         }
                   8162:         if (!defined($possible_status)) { 
                   8163:             $sectioncount{$section}++;
                   8164:         } else {
                   8165:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8166:                 $status = 'active';
                   8167:             } elsif ($end < $now) {
                   8168:                 $status = 'future';
                   8169:             } elsif ($start > $now) {
                   8170:                 $status = 'previous';
                   8171:             }
                   8172:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8173:                 $sectioncount{$section}++;
                   8174:             }
                   8175:         }
1.233     raeburn  8176:     }
1.366     albertel 8177:     return %sectioncount;
1.233     raeburn  8178: }
                   8179: 
1.274     raeburn  8180: ###############################################
1.294     raeburn  8181: 
                   8182: =pod
1.405     albertel 8183: 
                   8184: =item * &get_course_users()
                   8185: 
1.275     raeburn  8186: Retrieves usernames:domains for users in the specified course
                   8187: with specific role(s), and access status. 
                   8188: 
                   8189: Incoming parameters:
1.277     albertel 8190: 1. course domain
                   8191: 2. course number
                   8192: 3. access status: users must have - either active, 
1.275     raeburn  8193: previous, future, or all.
1.277     albertel 8194: 4. reference to array of permissible roles
1.288     raeburn  8195: 5. reference to array of section restrictions (optional)
                   8196: 6. reference to results object (hash of hashes).
                   8197: 7. reference to optional userdata hash
1.609     raeburn  8198: 8. reference to optional statushash
1.630     raeburn  8199: 9. flag if privileged users (except those set to unhide in
                   8200:    course settings) should be excluded    
1.609     raeburn  8201: Keys of top level results hash are roles.
1.275     raeburn  8202: Keys of inner hashes are username:domain, with 
                   8203: values set to access type.
1.288     raeburn  8204: Optional userdata hash returns an array with arguments in the 
                   8205: same order as loncoursedata::get_classlist() for student data.
                   8206: 
1.609     raeburn  8207: Optional statushash returns
                   8208: 
1.288     raeburn  8209: Entries for end, start, section and status are blank because
                   8210: of the possibility of multiple values for non-student roles.
                   8211: 
1.275     raeburn  8212: =cut
1.405     albertel 8213: 
1.275     raeburn  8214: ###############################################
1.405     albertel 8215: 
1.275     raeburn  8216: sub get_course_users {
1.630     raeburn  8217:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8218:     my %idx = ();
1.419     raeburn  8219:     my %seclists;
1.288     raeburn  8220: 
                   8221:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8222:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8223:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8224:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8225:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8226:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8227:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8228:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8229: 
1.290     albertel 8230:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8231:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8232:         my $now = time;
1.277     albertel 8233:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8234:             my $match = 0;
1.412     raeburn  8235:             my $secmatch = 0;
1.419     raeburn  8236:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8237:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8238:             if ($section eq '') {
                   8239:                 $section = 'none';
                   8240:             }
1.291     albertel 8241:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8242:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8243:                     $secmatch = 1;
                   8244:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8245:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8246:                         $secmatch = 1;
                   8247:                     }
                   8248:                 } else {  
1.419     raeburn  8249: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8250: 		        $secmatch = 1;
                   8251:                     }
1.290     albertel 8252: 		}
1.412     raeburn  8253:                 if (!$secmatch) {
                   8254:                     next;
                   8255:                 }
1.419     raeburn  8256:             }
1.275     raeburn  8257:             if (defined($$types{'active'})) {
1.288     raeburn  8258:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8259:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8260:                     $match = 1;
1.275     raeburn  8261:                 }
                   8262:             }
                   8263:             if (defined($$types{'previous'})) {
1.609     raeburn  8264:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8265:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8266:                     $match = 1;
1.275     raeburn  8267:                 }
                   8268:             }
                   8269:             if (defined($$types{'future'})) {
1.609     raeburn  8270:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8271:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8272:                     $match = 1;
1.275     raeburn  8273:                 }
                   8274:             }
1.609     raeburn  8275:             if ($match) {
                   8276:                 push(@{$seclists{$student}},$section);
                   8277:                 if (ref($userdata) eq 'HASH') {
                   8278:                     $$userdata{$student} = $$classlist{$student};
                   8279:                 }
                   8280:                 if (ref($statushash) eq 'HASH') {
                   8281:                     $statushash->{$student}{'st'}{$section} = $status;
                   8282:                 }
1.288     raeburn  8283:             }
1.275     raeburn  8284:         }
                   8285:     }
1.412     raeburn  8286:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8287:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8288:         my $now = time;
1.609     raeburn  8289:         my %displaystatus = ( previous => 'Expired',
                   8290:                               active   => 'Active',
                   8291:                               future   => 'Future',
                   8292:                             );
1.630     raeburn  8293:         my %nothide;
                   8294:         if ($hidepriv) {
                   8295:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8296:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8297:                 if ($user !~ /:/) {
                   8298:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8299:                 } else {
                   8300:                     $nothide{$user} = 1;
                   8301:                 }
                   8302:             }
                   8303:         }
1.439     raeburn  8304:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8305:             my $match = 0;
1.412     raeburn  8306:             my $secmatch = 0;
1.439     raeburn  8307:             my $status;
1.412     raeburn  8308:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8309:             $user =~ s/:$//;
1.439     raeburn  8310:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8311:             if ($end == -1 || $start == -1) {
                   8312:                 next;
                   8313:             }
                   8314:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8315:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8316:                 my ($uname,$udom) = split(/:/,$user);
                   8317:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8318:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8319:                         $secmatch = 1;
                   8320:                     } elsif ($usec eq '') {
1.420     albertel 8321:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8322:                             $secmatch = 1;
                   8323:                         }
                   8324:                     } else {
                   8325:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8326:                             $secmatch = 1;
                   8327:                         }
                   8328:                     }
                   8329:                     if (!$secmatch) {
                   8330:                         next;
                   8331:                     }
1.288     raeburn  8332:                 }
1.419     raeburn  8333:                 if ($usec eq '') {
                   8334:                     $usec = 'none';
                   8335:                 }
1.275     raeburn  8336:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8337:                     if ($hidepriv) {
                   8338:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   8339:                             (!$nothide{$uname.':'.$udom})) {
                   8340:                             next;
                   8341:                         }
                   8342:                     }
1.503     raeburn  8343:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8344:                         $status = 'previous';
                   8345:                     } elsif ($start > $now) {
                   8346:                         $status = 'future';
                   8347:                     } else {
                   8348:                         $status = 'active';
                   8349:                     }
1.277     albertel 8350:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8351:                         if ($status eq $type) {
1.420     albertel 8352:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8353:                                 push(@{$$users{$role}{$user}},$type);
                   8354:                             }
1.288     raeburn  8355:                             $match = 1;
                   8356:                         }
                   8357:                     }
1.419     raeburn  8358:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8359:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8360: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8361:                         }
1.420     albertel 8362:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8363:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8364:                         }
1.609     raeburn  8365:                         if (ref($statushash) eq 'HASH') {
                   8366:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8367:                         }
1.275     raeburn  8368:                     }
                   8369:                 }
                   8370:             }
                   8371:         }
1.290     albertel 8372:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8373:             if ((defined($cdom)) && (defined($cnum))) {
                   8374:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8375:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8376:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8377:                     next if ($owner eq '');
                   8378:                     my ($ownername,$ownerdom);
                   8379:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8380:                         $ownername = $1;
                   8381:                         $ownerdom = $2;
                   8382:                     } else {
                   8383:                         $ownername = $owner;
                   8384:                         $ownerdom = $cdom;
                   8385:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8386:                     }
                   8387:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8388:                     if (defined($userdata) && 
1.609     raeburn  8389: 			!exists($$userdata{$owner})) {
                   8390: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8391:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8392:                             push(@{$seclists{$owner}},'none');
                   8393:                         }
                   8394:                         if (ref($statushash) eq 'HASH') {
                   8395:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8396:                         }
1.290     albertel 8397: 		    }
1.279     raeburn  8398:                 }
                   8399:             }
                   8400:         }
1.419     raeburn  8401:         foreach my $user (keys(%seclists)) {
                   8402:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8403:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8404:         }
1.275     raeburn  8405:     }
                   8406:     return;
                   8407: }
                   8408: 
1.288     raeburn  8409: sub get_user_info {
                   8410:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8411:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8412: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8413:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8414:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8415:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8416:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8417:     return;
                   8418: }
1.275     raeburn  8419: 
1.472     raeburn  8420: ###############################################
                   8421: 
                   8422: =pod
                   8423: 
                   8424: =item * &get_user_quota()
                   8425: 
                   8426: Retrieves quota assigned for storage of portfolio files for a user  
                   8427: 
                   8428: Incoming parameters:
                   8429: 1. user's username
                   8430: 2. user's domain
                   8431: 
                   8432: Returns:
1.536     raeburn  8433: 1. Disk quota (in Mb) assigned to student.
                   8434: 2. (Optional) Type of setting: custom or default
                   8435:    (individually assigned or default for user's 
                   8436:    institutional status).
                   8437: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8438:    or student - types as defined in localenroll::inst_usertypes 
                   8439:    for user's domain, which determines default quota for user.
                   8440: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8441: 
                   8442: If a value has been stored in the user's environment, 
1.536     raeburn  8443: it will return that, otherwise it returns the maximal default
                   8444: defined for the user's instituional status(es) in the domain.
1.472     raeburn  8445: 
                   8446: =cut
                   8447: 
                   8448: ###############################################
                   8449: 
                   8450: 
                   8451: sub get_user_quota {
                   8452:     my ($uname,$udom) = @_;
1.536     raeburn  8453:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8454:     if (!defined($udom)) {
                   8455:         $udom = $env{'user.domain'};
                   8456:     }
                   8457:     if (!defined($uname)) {
                   8458:         $uname = $env{'user.name'};
                   8459:     }
                   8460:     if (($udom eq '' || $uname eq '') ||
                   8461:         ($udom eq 'public') && ($uname eq 'public')) {
                   8462:         $quota = 0;
1.536     raeburn  8463:         $quotatype = 'default';
                   8464:         $defquota = 0; 
1.472     raeburn  8465:     } else {
1.536     raeburn  8466:         my $inststatus;
1.472     raeburn  8467:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8468:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  8469:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  8470:         } else {
1.536     raeburn  8471:             my %userenv = 
                   8472:                 &Apache::lonnet::get('environment',['portfolioquota',
                   8473:                                      'inststatus'],$udom,$uname);
1.472     raeburn  8474:             my ($tmp) = keys(%userenv);
                   8475:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8476:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  8477:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  8478:             } else {
                   8479:                 undef(%userenv);
                   8480:             }
                   8481:         }
1.536     raeburn  8482:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  8483:         if ($quota eq '') {
1.536     raeburn  8484:             $quota = $defquota;
                   8485:             $quotatype = 'default';
                   8486:         } else {
                   8487:             $quotatype = 'custom';
1.472     raeburn  8488:         }
                   8489:     }
1.536     raeburn  8490:     if (wantarray) {
                   8491:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8492:     } else {
                   8493:         return $quota;
                   8494:     }
1.472     raeburn  8495: }
                   8496: 
                   8497: ###############################################
                   8498: 
                   8499: =pod
                   8500: 
                   8501: =item * &default_quota()
                   8502: 
1.536     raeburn  8503: Retrieves default quota assigned for storage of user portfolio files,
                   8504: given an (optional) user's institutional status.
1.472     raeburn  8505: 
                   8506: Incoming parameters:
                   8507: 1. domain
1.536     raeburn  8508: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8509:    status types (e.g., faculty, staff, student etc.)
                   8510:    which apply to the user for whom the default is being retrieved.
                   8511:    If the institutional status string in undefined, the domain
                   8512:    default quota will be returned. 
1.472     raeburn  8513: 
                   8514: Returns:
                   8515: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8516: 2. (Optional) institutional type which determined the value of the
                   8517:    default quota.
1.472     raeburn  8518: 
                   8519: If a value has been stored in the domain's configuration db,
                   8520: it will return that, otherwise it returns 20 (for backwards 
                   8521: compatibility with domains which have not set up a configuration
                   8522: db file; the original statically defined portfolio quota was 20 Mb). 
                   8523: 
1.536     raeburn  8524: If the user's status includes multiple types (e.g., staff and student),
                   8525: the largest default quota which applies to the user determines the
                   8526: default quota returned.
                   8527: 
1.780     raeburn  8528: =back
                   8529: 
1.472     raeburn  8530: =cut
                   8531: 
                   8532: ###############################################
                   8533: 
                   8534: 
                   8535: sub default_quota {
1.536     raeburn  8536:     my ($udom,$inststatus) = @_;
                   8537:     my ($defquota,$settingstatus);
                   8538:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8539:                                             ['quotas'],$udom);
                   8540:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8541:         if ($inststatus ne '') {
1.765     raeburn  8542:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8543:             foreach my $item (@statuses) {
1.711     raeburn  8544:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8545:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   8546:                         if ($defquota eq '') {
                   8547:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8548:                             $settingstatus = $item;
                   8549:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   8550:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8551:                             $settingstatus = $item;
                   8552:                         }
                   8553:                     }
                   8554:                 } else {
                   8555:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8556:                         if ($defquota eq '') {
                   8557:                             $defquota = $quotahash{'quotas'}{$item};
                   8558:                             $settingstatus = $item;
                   8559:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8560:                             $defquota = $quotahash{'quotas'}{$item};
                   8561:                             $settingstatus = $item;
                   8562:                         }
1.536     raeburn  8563:                     }
                   8564:                 }
                   8565:             }
                   8566:         }
                   8567:         if ($defquota eq '') {
1.711     raeburn  8568:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8569:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   8570:             } else {
                   8571:                 $defquota = $quotahash{'quotas'}{'default'};
                   8572:             }
1.536     raeburn  8573:             $settingstatus = 'default';
                   8574:         }
                   8575:     } else {
                   8576:         $settingstatus = 'default';
                   8577:         $defquota = 20;
                   8578:     }
                   8579:     if (wantarray) {
                   8580:         return ($defquota,$settingstatus);
1.472     raeburn  8581:     } else {
1.536     raeburn  8582:         return $defquota;
1.472     raeburn  8583:     }
                   8584: }
                   8585: 
1.384     raeburn  8586: sub get_secgrprole_info {
                   8587:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8588:     my %sections_count = &get_sections($cdom,$cnum);
                   8589:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8590:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8591:     my @groups = sort(keys(%curr_groups));
                   8592:     my $allroles = [];
                   8593:     my $rolehash;
                   8594:     my $accesshash = {
                   8595:                      active => 'Currently has access',
                   8596:                      future => 'Will have future access',
                   8597:                      previous => 'Previously had access',
                   8598:                   };
                   8599:     if ($needroles) {
                   8600:         $rolehash = {'all' => 'all'};
1.385     albertel 8601:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8602: 	if (&Apache::lonnet::error(%user_roles)) {
                   8603: 	    undef(%user_roles);
                   8604: 	}
                   8605:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8606:             my ($role)=split(/\:/,$item,2);
                   8607:             if ($role eq 'cr') { next; }
                   8608:             if ($role =~ /^cr/) {
                   8609:                 $$rolehash{$role} = (split('/',$role))[3];
                   8610:             } else {
                   8611:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8612:             }
                   8613:         }
                   8614:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8615:             push(@{$allroles},$key);
                   8616:         }
                   8617:         push (@{$allroles},'st');
                   8618:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8619:     }
                   8620:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8621: }
                   8622: 
1.555     raeburn  8623: sub user_picker {
1.994     raeburn  8624:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8625:     my $currdom = $dom;
                   8626:     my %curr_selected = (
                   8627:                         srchin => 'dom',
1.580     raeburn  8628:                         srchby => 'lastname',
1.555     raeburn  8629:                       );
                   8630:     my $srchterm;
1.625     raeburn  8631:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8632:         if ($srch->{'srchby'} ne '') {
                   8633:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8634:         }
                   8635:         if ($srch->{'srchin'} ne '') {
                   8636:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8637:         }
                   8638:         if ($srch->{'srchtype'} ne '') {
                   8639:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8640:         }
                   8641:         if ($srch->{'srchdomain'} ne '') {
                   8642:             $currdom = $srch->{'srchdomain'};
                   8643:         }
                   8644:         $srchterm = $srch->{'srchterm'};
                   8645:     }
                   8646:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8647:                     'usr'       => 'Search criteria',
1.563     raeburn  8648:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8649:                     'uname'     => 'username',
                   8650:                     'lastname'  => 'last name',
1.555     raeburn  8651:                     'lastfirst' => 'last name, first name',
1.558     albertel 8652:                     'crs'       => 'in this course',
1.576     raeburn  8653:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8654:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8655:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8656:                     'exact'     => 'is',
                   8657:                     'contains'  => 'contains',
1.569     raeburn  8658:                     'begins'    => 'begins with',
1.571     raeburn  8659:                     'youm'      => "You must include some text to search for.",
                   8660:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8661:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8662:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8663:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8664:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8665:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8666:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8667:                                        );
1.563     raeburn  8668:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8669:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8670: 
                   8671:     my @srchins = ('crs','dom','alc','instd');
                   8672: 
                   8673:     foreach my $option (@srchins) {
                   8674:         # FIXME 'alc' option unavailable until 
                   8675:         #       loncreateuser::print_user_query_page()
                   8676:         #       has been completed.
                   8677:         next if ($option eq 'alc');
1.880     raeburn  8678:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8679:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8680:         if ($curr_selected{'srchin'} eq $option) {
                   8681:             $srchinsel .= ' 
                   8682:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8683:         } else {
                   8684:             $srchinsel .= '
                   8685:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8686:         }
1.555     raeburn  8687:     }
1.563     raeburn  8688:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8689: 
                   8690:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8691:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8692:         if ($curr_selected{'srchby'} eq $option) {
                   8693:             $srchbysel .= '
                   8694:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8695:         } else {
                   8696:             $srchbysel .= '
                   8697:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8698:          }
                   8699:     }
                   8700:     $srchbysel .= "\n  </select>\n";
                   8701: 
                   8702:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8703:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8704:         if ($curr_selected{'srchtype'} eq $option) {
                   8705:             $srchtypesel .= '
                   8706:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8707:         } else {
                   8708:             $srchtypesel .= '
                   8709:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8710:         }
                   8711:     }
                   8712:     $srchtypesel .= "\n  </select>\n";
                   8713: 
1.558     albertel 8714:     my ($newuserscript,$new_user_create);
1.994     raeburn  8715:     my $context_dom = $env{'request.role.domain'};
                   8716:     if ($context eq 'requestcrs') {
                   8717:         if ($env{'form.coursedom'} ne '') { 
                   8718:             $context_dom = $env{'form.coursedom'};
                   8719:         }
                   8720:     }
1.556     raeburn  8721:     if ($forcenewuser) {
1.576     raeburn  8722:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8723:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8724:                 if ($cancreate) {
                   8725:                     $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>';
                   8726:                 } else {
1.799     bisitz   8727:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8728:                     my %usertypetext = (
                   8729:                         official   => 'institutional',
                   8730:                         unofficial => 'non-institutional',
                   8731:                     );
1.799     bisitz   8732:                     $new_user_create = '<p class="LC_warning">'
                   8733:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8734:                                       .' '
                   8735:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8736:                                           ,'<a href="'.$helplink.'">','</a>')
                   8737:                                       .'</p><br />';
1.627     raeburn  8738:                 }
1.576     raeburn  8739:             }
                   8740:         }
                   8741: 
1.556     raeburn  8742:         $newuserscript = <<"ENDSCRIPT";
                   8743: 
1.570     raeburn  8744: function setSearch(createnew,callingForm) {
1.556     raeburn  8745:     if (createnew == 1) {
1.570     raeburn  8746:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8747:             if (callingForm.srchby.options[i].value == 'uname') {
                   8748:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8749:             }
                   8750:         }
1.570     raeburn  8751:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8752:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8753: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8754:             }
                   8755:         }
1.570     raeburn  8756:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8757:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8758:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8759:             }
                   8760:         }
1.570     raeburn  8761:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8762:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8763:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8764:             }
                   8765:         }
                   8766:     }
                   8767: }
                   8768: ENDSCRIPT
1.558     albertel 8769: 
1.556     raeburn  8770:     }
                   8771: 
1.555     raeburn  8772:     my $output = <<"END_BLOCK";
1.556     raeburn  8773: <script type="text/javascript">
1.824     bisitz   8774: // <![CDATA[
1.570     raeburn  8775: function validateEntry(callingForm) {
1.558     albertel 8776: 
1.556     raeburn  8777:     var checkok = 1;
1.558     albertel 8778:     var srchin;
1.570     raeburn  8779:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8780: 	if ( callingForm.srchin[i].checked ) {
                   8781: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8782: 	}
                   8783:     }
                   8784: 
1.570     raeburn  8785:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8786:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8787:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8788:     var srchterm =  callingForm.srchterm.value;
                   8789:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8790:     var msg = "";
                   8791: 
                   8792:     if (srchterm == "") {
                   8793:         checkok = 0;
1.571     raeburn  8794:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8795:     }
                   8796: 
1.569     raeburn  8797:     if (srchtype== 'begins') {
                   8798:         if (srchterm.length < 2) {
                   8799:             checkok = 0;
1.571     raeburn  8800:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8801:         }
                   8802:     }
                   8803: 
1.556     raeburn  8804:     if (srchtype== 'contains') {
                   8805:         if (srchterm.length < 3) {
                   8806:             checkok = 0;
1.571     raeburn  8807:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8808:         }
                   8809:     }
                   8810:     if (srchin == 'instd') {
                   8811:         if (srchdomain == '') {
                   8812:             checkok = 0;
1.571     raeburn  8813:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8814:         }
                   8815:     }
                   8816:     if (srchin == 'dom') {
                   8817:         if (srchdomain == '') {
                   8818:             checkok = 0;
1.571     raeburn  8819:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8820:         }
                   8821:     }
                   8822:     if (srchby == 'lastfirst') {
                   8823:         if (srchterm.indexOf(",") == -1) {
                   8824:             checkok = 0;
1.571     raeburn  8825:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8826:         }
                   8827:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8828:             checkok = 0;
1.571     raeburn  8829:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8830:         }
                   8831:     }
                   8832:     if (checkok == 0) {
1.571     raeburn  8833:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8834:         return;
                   8835:     }
                   8836:     if (checkok == 1) {
1.570     raeburn  8837:         callingForm.submit();
1.556     raeburn  8838:     }
                   8839: }
                   8840: 
                   8841: $newuserscript
                   8842: 
1.824     bisitz   8843: // ]]>
1.556     raeburn  8844: </script>
1.558     albertel 8845: 
                   8846: $new_user_create
                   8847: 
1.555     raeburn  8848: END_BLOCK
1.558     albertel 8849: 
1.876     raeburn  8850:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8851:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8852:                $domform.
                   8853:                &Apache::lonhtmlcommon::row_closure().
                   8854:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8855:                $srchbysel.
                   8856:                $srchtypesel. 
                   8857:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8858:                $srchinsel.
                   8859:                &Apache::lonhtmlcommon::row_closure(1). 
                   8860:                &Apache::lonhtmlcommon::end_pick_box().
                   8861:                '<br />';
1.555     raeburn  8862:     return $output;
                   8863: }
                   8864: 
1.612     raeburn  8865: sub user_rule_check {
1.615     raeburn  8866:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8867:     my $response;
                   8868:     if (ref($usershash) eq 'HASH') {
                   8869:         foreach my $user (keys(%{$usershash})) {
                   8870:             my ($uname,$udom) = split(/:/,$user);
                   8871:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8872:             my ($id,$newuser);
1.612     raeburn  8873:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8874:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8875:                 $id = $usershash->{$user}->{'id'};
                   8876:             }
                   8877:             my $inst_response;
                   8878:             if (ref($checks) eq 'HASH') {
                   8879:                 if (defined($checks->{'username'})) {
1.615     raeburn  8880:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8881:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8882:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8883:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8884:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8885:                 }
1.615     raeburn  8886:             } else {
                   8887:                 ($inst_response,%{$inst_results->{$user}}) =
                   8888:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8889:                 return;
1.612     raeburn  8890:             }
1.615     raeburn  8891:             if (!$got_rules->{$udom}) {
1.612     raeburn  8892:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8893:                                                   ['usercreation'],$udom);
                   8894:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8895:                     foreach my $item ('username','id') {
1.612     raeburn  8896:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8897:                             $$curr_rules{$udom}{$item} = 
                   8898:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8899:                         }
                   8900:                     }
                   8901:                 }
1.615     raeburn  8902:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8903:             }
1.612     raeburn  8904:             foreach my $item (keys(%{$checks})) {
                   8905:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8906:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8907:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8908:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8909:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8910:                                 if ($rule_check{$rule}) {
                   8911:                                     $$rulematch{$user}{$item} = $rule;
                   8912:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8913:                                         if (ref($inst_results) eq 'HASH') {
                   8914:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8915:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8916:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8917:                                                 }
1.612     raeburn  8918:                                             }
                   8919:                                         }
1.615     raeburn  8920:                                     }
                   8921:                                     last;
1.585     raeburn  8922:                                 }
                   8923:                             }
                   8924:                         }
                   8925:                     }
                   8926:                 }
                   8927:             }
                   8928:         }
                   8929:     }
1.612     raeburn  8930:     return;
                   8931: }
                   8932: 
                   8933: sub user_rule_formats {
                   8934:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8935:     my %text = ( 
                   8936:                  'username' => 'Usernames',
                   8937:                  'id'       => 'IDs',
                   8938:                );
                   8939:     my $output;
                   8940:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8941:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8942:         if (@{$ruleorder} > 0) {
                   8943:             $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';
                   8944:             foreach my $rule (@{$ruleorder}) {
                   8945:                 if (ref($curr_rules) eq 'ARRAY') {
                   8946:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8947:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8948:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8949:                                         $rules->{$rule}{'desc'}.'</li>';
                   8950:                         }
                   8951:                     }
                   8952:                 }
                   8953:             }
                   8954:             $output .= '</ul>';
                   8955:         }
                   8956:     }
                   8957:     return $output;
                   8958: }
                   8959: 
                   8960: sub instrule_disallow_msg {
1.615     raeburn  8961:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8962:     my $response;
                   8963:     my %text = (
                   8964:                   item   => 'username',
                   8965:                   items  => 'usernames',
                   8966:                   match  => 'matches',
                   8967:                   do     => 'does',
                   8968:                   action => 'a username',
                   8969:                   one    => 'one',
                   8970:                );
                   8971:     if ($count > 1) {
                   8972:         $text{'item'} = 'usernames';
                   8973:         $text{'match'} ='match';
                   8974:         $text{'do'} = 'do';
                   8975:         $text{'action'} = 'usernames',
                   8976:         $text{'one'} = 'ones';
                   8977:     }
                   8978:     if ($checkitem eq 'id') {
                   8979:         $text{'items'} = 'IDs';
                   8980:         $text{'item'} = 'ID';
                   8981:         $text{'action'} = 'an ID';
1.615     raeburn  8982:         if ($count > 1) {
                   8983:             $text{'item'} = 'IDs';
                   8984:             $text{'action'} = 'IDs';
                   8985:         }
1.612     raeburn  8986:     }
1.674     bisitz   8987:     $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  8988:     if ($mode eq 'upload') {
                   8989:         if ($checkitem eq 'username') {
                   8990:             $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'}.");
                   8991:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8992:             $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  8993:         }
1.669     raeburn  8994:     } elsif ($mode eq 'selfcreate') {
                   8995:         if ($checkitem eq 'id') {
                   8996:             $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.");
                   8997:         }
1.615     raeburn  8998:     } else {
                   8999:         if ($checkitem eq 'username') {
                   9000:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9001:         } elsif ($checkitem eq 'id') {
                   9002:             $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.");
                   9003:         }
1.612     raeburn  9004:     }
                   9005:     return $response;
1.585     raeburn  9006: }
                   9007: 
1.624     raeburn  9008: sub personal_data_fieldtitles {
                   9009:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9010:                         id => 'Student/Employee ID',
                   9011:                         permanentemail => 'E-mail address',
                   9012:                         lastname => 'Last Name',
                   9013:                         firstname => 'First Name',
                   9014:                         middlename => 'Middle Name',
                   9015:                         generation => 'Generation',
                   9016:                         gen => 'Generation',
1.765     raeburn  9017:                         inststatus => 'Affiliation',
1.624     raeburn  9018:                    );
                   9019:     return %fieldtitles;
                   9020: }
                   9021: 
1.642     raeburn  9022: sub sorted_inst_types {
                   9023:     my ($dom) = @_;
                   9024:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9025:     my $othertitle = &mt('All users');
                   9026:     if ($env{'request.course.id'}) {
1.668     raeburn  9027:         $othertitle  = &mt('Any users');
1.642     raeburn  9028:     }
                   9029:     my @types;
                   9030:     if (ref($order) eq 'ARRAY') {
                   9031:         @types = @{$order};
                   9032:     }
                   9033:     if (@types == 0) {
                   9034:         if (ref($usertypes) eq 'HASH') {
                   9035:             @types = sort(keys(%{$usertypes}));
                   9036:         }
                   9037:     }
                   9038:     if (keys(%{$usertypes}) > 0) {
                   9039:         $othertitle = &mt('Other users');
                   9040:     }
                   9041:     return ($othertitle,$usertypes,\@types);
                   9042: }
                   9043: 
1.645     raeburn  9044: sub get_institutional_codes {
                   9045:     my ($settings,$allcourses,$LC_code) = @_;
                   9046: # Get complete list of course sections to update
                   9047:     my @currsections = ();
                   9048:     my @currxlists = ();
                   9049:     my $coursecode = $$settings{'internal.coursecode'};
                   9050: 
                   9051:     if ($$settings{'internal.sectionnums'} ne '') {
                   9052:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9053:     }
                   9054: 
                   9055:     if ($$settings{'internal.crosslistings'} ne '') {
                   9056:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9057:     }
                   9058: 
                   9059:     if (@currxlists > 0) {
                   9060:         foreach (@currxlists) {
                   9061:             if (m/^([^:]+):(\w*)$/) {
                   9062:                 unless (grep/^$1$/,@{$allcourses}) {
                   9063:                     push @{$allcourses},$1;
                   9064:                     $$LC_code{$1} = $2;
                   9065:                 }
                   9066:             }
                   9067:         }
                   9068:     }
                   9069:  
                   9070:     if (@currsections > 0) {
                   9071:         foreach (@currsections) {
                   9072:             if (m/^(\w+):(\w*)$/) {
                   9073:                 my $sec = $coursecode.$1;
                   9074:                 my $lc_sec = $2;
                   9075:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9076:                     push @{$allcourses},$sec;
                   9077:                     $$LC_code{$sec} = $lc_sec;
                   9078:                 }
                   9079:             }
                   9080:         }
                   9081:     }
                   9082:     return;
                   9083: }
                   9084: 
1.971     raeburn  9085: sub get_standard_codeitems {
                   9086:     return ('Year','Semester','Department','Number','Section');
                   9087: }
                   9088: 
1.112     bowersj2 9089: =pod
                   9090: 
1.780     raeburn  9091: =head1 Slot Helpers
                   9092: 
                   9093: =over 4
                   9094: 
                   9095: =item * sorted_slots()
                   9096: 
1.1040    raeburn  9097: Sorts an array of slot names in order of an optional sort key,
                   9098: default sort is by slot start time (earliest first). 
1.780     raeburn  9099: 
                   9100: Inputs:
                   9101: 
                   9102: =over 4
                   9103: 
                   9104: slotsarr  - Reference to array of unsorted slot names.
                   9105: 
                   9106: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9107: 
1.1040    raeburn  9108: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9109: 
1.549     albertel 9110: =back
                   9111: 
1.780     raeburn  9112: Returns:
                   9113: 
                   9114: =over 4
                   9115: 
1.1040    raeburn  9116: sorted   - An array of slot names sorted by a specified sort key 
                   9117:            (default sort key is start time of the slot).
1.780     raeburn  9118: 
                   9119: =back
                   9120: 
                   9121: =cut
                   9122: 
                   9123: 
                   9124: sub sorted_slots {
1.1040    raeburn  9125:     my ($slotsarr,$slots,$sortkey) = @_;
                   9126:     if ($sortkey eq '') {
                   9127:         $sortkey = 'starttime';
                   9128:     }
1.780     raeburn  9129:     my @sorted;
                   9130:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9131:         @sorted =
                   9132:             sort {
                   9133:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9134:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9135:                      }
                   9136:                      if (ref($slots->{$a})) { return -1;}
                   9137:                      if (ref($slots->{$b})) { return 1;}
                   9138:                      return 0;
                   9139:                  } @{$slotsarr};
                   9140:     }
                   9141:     return @sorted;
                   9142: }
                   9143: 
1.1040    raeburn  9144: =pod
                   9145: 
                   9146: =item * get_future_slots()
                   9147: 
                   9148: Inputs:
                   9149: 
                   9150: =over 4
                   9151: 
                   9152: cnum - course number
                   9153: 
                   9154: cdom - course domain
                   9155: 
                   9156: now - current UNIX time
                   9157: 
                   9158: symb - optional symb
                   9159: 
                   9160: =back
                   9161: 
                   9162: Returns:
                   9163: 
                   9164: =over 4
                   9165: 
                   9166: sorted_reservable - ref to array of student_schedulable slots currently 
                   9167:                     reservable, ordered by end date of reservation period.
                   9168: 
                   9169: reservable_now - ref to hash of student_schedulable slots currently
                   9170:                  reservable.
                   9171: 
                   9172:     Keys in inner hash are:
                   9173:     (a) symb: either blank or symb to which slot use is restricted.
                   9174:     (b) endreserve: end date of reservation period. 
                   9175: 
                   9176: sorted_future - ref to array of student_schedulable slots reservable in
                   9177:                 the future, ordered by start date of reservation period.
                   9178: 
                   9179: future_reservable - ref to hash of student_schedulable slots reservable
                   9180:                     in the future.
                   9181: 
                   9182:     Keys in inner hash are:
                   9183:     (a) symb: either blank or symb to which slot use is restricted.
                   9184:     (b) startreserve:  start date of reservation period.
                   9185: 
                   9186: =back
                   9187: 
                   9188: =cut
                   9189: 
                   9190: sub get_future_slots {
                   9191:     my ($cnum,$cdom,$now,$symb) = @_;
                   9192:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9193:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9194:     foreach my $slot (keys(%slots)) {
                   9195:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9196:         if ($symb) {
                   9197:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9198:                      ($slots{$slot}->{'symb'} ne $symb));
                   9199:         }
                   9200:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9201:             ($slots{$slot}->{'endtime'} > $now)) {
                   9202:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9203:                 my $userallowed = 0;
                   9204:                 if ($slots{$slot}->{'allowedsections'}) {
                   9205:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9206:                     if (!defined($env{'request.role.sec'})
                   9207:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9208:                         $userallowed=1;
                   9209:                     } else {
                   9210:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9211:                             $userallowed=1;
                   9212:                         }
                   9213:                     }
                   9214:                     unless ($userallowed) {
                   9215:                         if (defined($env{'request.course.groups'})) {
                   9216:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9217:                             foreach my $group (@groups) {
                   9218:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9219:                                     $userallowed=1;
                   9220:                                     last;
                   9221:                                 }
                   9222:                             }
                   9223:                         }
                   9224:                     }
                   9225:                 }
                   9226:                 if ($slots{$slot}->{'allowedusers'}) {
                   9227:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9228:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9229:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9230:                         $userallowed = 1;
                   9231:                     }
                   9232:                 }
                   9233:                 next unless($userallowed);
                   9234:             }
                   9235:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9236:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9237:             my $symb = $slots{$slot}->{'symb'};
                   9238:             if (($startreserve < $now) &&
                   9239:                 (!$endreserve || $endreserve > $now)) {
                   9240:                 my $lastres = $endreserve;
                   9241:                 if (!$lastres) {
                   9242:                     $lastres = $slots{$slot}->{'starttime'};
                   9243:                 }
                   9244:                 $reservable_now{$slot} = {
                   9245:                                            symb       => $symb,
                   9246:                                            endreserve => $lastres
                   9247:                                          };
                   9248:             } elsif (($startreserve > $now) &&
                   9249:                      (!$endreserve || $endreserve > $startreserve)) {
                   9250:                 $future_reservable{$slot} = {
                   9251:                                               symb         => $symb,
                   9252:                                               startreserve => $startreserve
                   9253:                                             };
                   9254:             }
                   9255:         }
                   9256:     }
                   9257:     my @unsorted_reservable = keys(%reservable_now);
                   9258:     if (@unsorted_reservable > 0) {
                   9259:         @sorted_reservable = 
                   9260:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9261:     }
                   9262:     my @unsorted_future = keys(%future_reservable);
                   9263:     if (@unsorted_future > 0) {
                   9264:         @sorted_future =
                   9265:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9266:     }
                   9267:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9268: }
1.780     raeburn  9269: 
                   9270: =pod
                   9271: 
1.1057    foxr     9272: =back
                   9273: 
1.549     albertel 9274: =head1 HTTP Helpers
                   9275: 
                   9276: =over 4
                   9277: 
1.648     raeburn  9278: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9279: 
1.258     albertel 9280: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9281: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9282: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9283: 
                   9284: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9285: $possible_names is an ref to an array of form element names.  As an example:
                   9286: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9287: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9288: 
                   9289: =cut
1.1       albertel 9290: 
1.6       albertel 9291: sub get_unprocessed_cgi {
1.25      albertel 9292:   my ($query,$possible_names)= @_;
1.26      matthew  9293:   # $Apache::lonxml::debug=1;
1.356     albertel 9294:   foreach my $pair (split(/&/,$query)) {
                   9295:     my ($name, $value) = split(/=/,$pair);
1.369     www      9296:     $name = &unescape($name);
1.25      albertel 9297:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9298:       $value =~ tr/+/ /;
                   9299:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9300:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9301:     }
1.16      harris41 9302:   }
1.6       albertel 9303: }
                   9304: 
1.112     bowersj2 9305: =pod
                   9306: 
1.648     raeburn  9307: =item * &cacheheader() 
1.112     bowersj2 9308: 
                   9309: returns cache-controlling header code
                   9310: 
                   9311: =cut
                   9312: 
1.7       albertel 9313: sub cacheheader {
1.258     albertel 9314:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9315:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9316:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9317:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9318:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9319:     return $output;
1.7       albertel 9320: }
                   9321: 
1.112     bowersj2 9322: =pod
                   9323: 
1.648     raeburn  9324: =item * &no_cache($r) 
1.112     bowersj2 9325: 
                   9326: specifies header code to not have cache
                   9327: 
                   9328: =cut
                   9329: 
1.9       albertel 9330: sub no_cache {
1.216     albertel 9331:     my ($r) = @_;
                   9332:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9333: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9334:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9335:     $r->no_cache(1);
                   9336:     $r->header_out("Expires" => $date);
                   9337:     $r->header_out("Pragma" => "no-cache");
1.123     www      9338: }
                   9339: 
                   9340: sub content_type {
1.181     albertel 9341:     my ($r,$type,$charset) = @_;
1.299     foxr     9342:     if ($r) {
                   9343: 	#  Note that printout.pl calls this with undef for $r.
                   9344: 	&no_cache($r);
                   9345:     }
1.258     albertel 9346:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9347:     unless ($charset) {
                   9348: 	$charset=&Apache::lonlocal::current_encoding;
                   9349:     }
                   9350:     if ($charset) { $type.='; charset='.$charset; }
                   9351:     if ($r) {
                   9352: 	$r->content_type($type);
                   9353:     } else {
                   9354: 	print("Content-type: $type\n\n");
                   9355:     }
1.9       albertel 9356: }
1.25      albertel 9357: 
1.112     bowersj2 9358: =pod
                   9359: 
1.648     raeburn  9360: =item * &add_to_env($name,$value) 
1.112     bowersj2 9361: 
1.258     albertel 9362: adds $name to the %env hash with value
1.112     bowersj2 9363: $value, if $name already exists, the entry is converted to an array
                   9364: reference and $value is added to the array.
                   9365: 
                   9366: =cut
                   9367: 
1.25      albertel 9368: sub add_to_env {
                   9369:   my ($name,$value)=@_;
1.258     albertel 9370:   if (defined($env{$name})) {
                   9371:     if (ref($env{$name})) {
1.25      albertel 9372:       #already have multiple values
1.258     albertel 9373:       push(@{ $env{$name} },$value);
1.25      albertel 9374:     } else {
                   9375:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9376:       my $first=$env{$name};
                   9377:       undef($env{$name});
                   9378:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9379:     }
                   9380:   } else {
1.258     albertel 9381:     $env{$name}=$value;
1.25      albertel 9382:   }
1.31      albertel 9383: }
1.149     albertel 9384: 
                   9385: =pod
                   9386: 
1.648     raeburn  9387: =item * &get_env_multiple($name) 
1.149     albertel 9388: 
1.258     albertel 9389: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9390: values may be defined and end up as an array ref.
                   9391: 
                   9392: returns an array of values
                   9393: 
                   9394: =cut
                   9395: 
                   9396: sub get_env_multiple {
                   9397:     my ($name) = @_;
                   9398:     my @values;
1.258     albertel 9399:     if (defined($env{$name})) {
1.149     albertel 9400:         # exists is it an array
1.258     albertel 9401:         if (ref($env{$name})) {
                   9402:             @values=@{ $env{$name} };
1.149     albertel 9403:         } else {
1.258     albertel 9404:             $values[0]=$env{$name};
1.149     albertel 9405:         }
                   9406:     }
                   9407:     return(@values);
                   9408: }
                   9409: 
1.660     raeburn  9410: sub ask_for_embedded_content {
                   9411:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9412:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  9413:         %currsubfile,%unused,$rem);
1.1071    raeburn  9414:     my $counter = 0;
                   9415:     my $numnew = 0;
1.987     raeburn  9416:     my $numremref = 0;
                   9417:     my $numinvalid = 0;
                   9418:     my $numpathchg = 0;
                   9419:     my $numexisting = 0;
1.1071    raeburn  9420:     my $numunused = 0;
                   9421:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9422:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9423:     my $heading = &mt('Upload embedded files');
                   9424:     my $buttontext = &mt('Upload');
                   9425: 
1.1085    raeburn  9426:     my $navmap;
                   9427:     if ($env{'request.course.id'}) {
                   9428:         $navmap = Apache::lonnavmaps::navmap->new();
                   9429:     }
1.984     raeburn  9430:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9431:         my $current_path='/';
                   9432:         if ($env{'form.currentpath'}) {
                   9433:             $current_path = $env{'form.currentpath'};
                   9434:         }
                   9435:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   9436:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9437:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9438:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9439:         } else {
                   9440:             $udom = $env{'user.domain'};
                   9441:             $uname = $env{'user.name'};
                   9442:             $url = '/userfiles/portfolio';
                   9443:         }
1.987     raeburn  9444:         $toplevel = $url.'/';
1.984     raeburn  9445:         $url .= $current_path;
                   9446:         $getpropath = 1;
1.987     raeburn  9447:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9448:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9449:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9450:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9451:         $toplevel = $url;
1.984     raeburn  9452:         if ($rest ne '') {
1.987     raeburn  9453:             $url .= $rest;
                   9454:         }
                   9455:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9456:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9457:             $url = $args->{'docs_url'};
                   9458:             $toplevel = $url;
1.1084    raeburn  9459:             if ($args->{'context'} eq 'paste') {
                   9460:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9461:                 ($path) = 
                   9462:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9463:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9464:                 $fileloc =~ s{^/}{};
                   9465:             }
1.1071    raeburn  9466:         }
1.1084    raeburn  9467:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  9468:         if ($env{'request.course.id'} ne '') {
                   9469:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9470:             $cnum =  $env{'course.'.$env{'request.course.id'}.'.num'};
                   9471:             if (ref($args) eq 'HASH') {
                   9472:                 $url = $args->{'docs_url'};
                   9473:                 $title = $args->{'docs_title'};
                   9474:                 $toplevel = "/$url";
1.1085    raeburn  9475:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071    raeburn  9476:                 ($path) =  
                   9477:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9478:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9479:                 $fileloc =~ s{^/}{};
                   9480:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9481:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9482:             }
1.987     raeburn  9483:         }
                   9484:     }
                   9485:     my $now = time();
                   9486:     foreach my $embed_file (keys(%{$allfiles})) {
                   9487:         my $absolutepath;
                   9488:         if ($embed_file =~ m{^\w+://}) {
                   9489:             $newfiles{$embed_file} = 1;
                   9490:             $mapping{$embed_file} = $embed_file;
                   9491:         } else {
                   9492:             if ($embed_file =~ m{^/}) {
                   9493:                 $absolutepath = $embed_file;
                   9494:                 $embed_file =~ s{^(/+)}{};
                   9495:             }
                   9496:             if ($embed_file =~ m{/}) {
                   9497:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   9498:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9499:                 my $item = $fname;
                   9500:                 if ($path ne '') {
                   9501:                     $item = $path.'/'.$fname;
                   9502:                     $subdependencies{$path}{$fname} = 1;
                   9503:                 } else {
                   9504:                     $dependencies{$item} = 1;
                   9505:                 }
                   9506:                 if ($absolutepath) {
                   9507:                     $mapping{$item} = $absolutepath;
                   9508:                 } else {
                   9509:                     $mapping{$item} = $embed_file;
                   9510:                 }
                   9511:             } else {
                   9512:                 $dependencies{$embed_file} = 1;
                   9513:                 if ($absolutepath) {
                   9514:                     $mapping{$embed_file} = $absolutepath;
                   9515:                 } else {
                   9516:                     $mapping{$embed_file} = $embed_file;
                   9517:                 }
                   9518:             }
1.984     raeburn  9519:         }
                   9520:     }
1.1071    raeburn  9521:     my $dirptr = 16384;
1.984     raeburn  9522:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9523:         $currsubfile{$path} = {};
1.984     raeburn  9524:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9525:             my ($sublistref,$listerror) =
                   9526:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9527:             if (ref($sublistref) eq 'ARRAY') {
                   9528:                 foreach my $line (@{$sublistref}) {
                   9529:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9530:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9531:                 }
1.984     raeburn  9532:             }
1.987     raeburn  9533:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9534:             if (opendir(my $dir,$url.'/'.$path)) {
                   9535:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9536:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9537:             }
1.1084    raeburn  9538:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9539:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9540:                   ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9541:             if ($env{'request.course.id'} ne '') {
                   9542:                 my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9543:                 if ($dir ne '') {
                   9544:                     my ($sublistref,$listerror) =
                   9545:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9546:                     if (ref($sublistref) eq 'ARRAY') {
                   9547:                         foreach my $line (@{$sublistref}) {
                   9548:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9549:                                 undef,$mtime)=split(/\&/,$line,12);
                   9550:                             unless (($testdir&$dirptr) ||
                   9551:                                     ($file_name =~ /^\.\.?$/)) {
                   9552:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9553:                             }
                   9554:                         }
                   9555:                     }
                   9556:                 }
1.984     raeburn  9557:             }
                   9558:         }
                   9559:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9560:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9561:                 my $item = $path.'/'.$file;
                   9562:                 unless ($mapping{$item} eq $item) {
                   9563:                     $pathchanges{$item} = 1;
                   9564:                 }
                   9565:                 $existing{$item} = 1;
                   9566:                 $numexisting ++;
                   9567:             } else {
                   9568:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9569:             }
                   9570:         }
1.1071    raeburn  9571:         if ($actionurl eq '/adm/dependencies') {
                   9572:             foreach my $path (keys(%currsubfile)) {
                   9573:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9574:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9575:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  9576:                              next if (($rem ne '') &&
                   9577:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9578:                                        (ref($navmap) &&
                   9579:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9580:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9581:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9582:                              $unused{$path.'/'.$file} = 1; 
                   9583:                          }
                   9584:                     }
                   9585:                 }
                   9586:             }
                   9587:         }
1.984     raeburn  9588:     }
1.987     raeburn  9589:     my %currfile;
1.984     raeburn  9590:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9591:         my ($dirlistref,$listerror) =
                   9592:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9593:         if (ref($dirlistref) eq 'ARRAY') {
                   9594:             foreach my $line (@{$dirlistref}) {
                   9595:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9596:                 $currfile{$file_name} = 1;
                   9597:             }
1.984     raeburn  9598:         }
1.987     raeburn  9599:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9600:         if (opendir(my $dir,$url)) {
1.987     raeburn  9601:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9602:             map {$currfile{$_} = 1;} @dir_list;
                   9603:         }
1.1084    raeburn  9604:     } elsif (($actionurl eq '/adm/dependencies') ||
                   9605:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9606:               ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9607:         if ($env{'request.course.id'} ne '') {
                   9608:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9609:             if ($dir ne '') {
                   9610:                 my ($dirlistref,$listerror) =
                   9611:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9612:                 if (ref($dirlistref) eq 'ARRAY') {
                   9613:                     foreach my $line (@{$dirlistref}) {
                   9614:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   9615:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   9616:                         unless (($testdir&$dirptr) ||
                   9617:                                 ($file_name =~ /^\.\.?$/)) {
                   9618:                             $currfile{$file_name} = [$size,$mtime];
                   9619:                         }
                   9620:                     }
                   9621:                 }
                   9622:             }
                   9623:         }
1.984     raeburn  9624:     }
                   9625:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  9626:         if (exists($currfile{$file})) {
1.987     raeburn  9627:             unless ($mapping{$file} eq $file) {
                   9628:                 $pathchanges{$file} = 1;
                   9629:             }
                   9630:             $existing{$file} = 1;
                   9631:             $numexisting ++;
                   9632:         } else {
1.984     raeburn  9633:             $newfiles{$file} = 1;
                   9634:         }
                   9635:     }
1.1071    raeburn  9636:     foreach my $file (keys(%currfile)) {
                   9637:         unless (($file eq $filename) ||
                   9638:                 ($file eq $filename.'.bak') ||
                   9639:                 ($dependencies{$file})) {
1.1085    raeburn  9640:             if ($actionurl eq '/adm/dependencies') {
                   9641:                 next if (($rem ne '') &&
                   9642:                          (($env{"httpref.$rem".$file} ne '') ||
                   9643:                           (ref($navmap) &&
                   9644:                           (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   9645:                            (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9646:                             ($navmap->getResourceByUrl($rem.$1)))))));
                   9647:             }
1.1071    raeburn  9648:             $unused{$file} = 1;
                   9649:         }
                   9650:     }
1.1084    raeburn  9651:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9652:         ($args->{'context'} eq 'paste')) {
                   9653:         $counter = scalar(keys(%existing));
                   9654:         $numpathchg = scalar(keys(%pathchanges));
                   9655:         return ($output,$counter,$numpathchg,\%existing); 
                   9656:     }
1.984     raeburn  9657:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  9658:         if ($actionurl eq '/adm/dependencies') {
                   9659:             next if ($embed_file =~ m{^\w+://});
                   9660:         }
1.660     raeburn  9661:         $upload_output .= &start_data_table_row().
1.1071    raeburn  9662:                           '<td><img src="'.&icon($embed_file).'" />&nbsp;'.
                   9663:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  9664:         unless ($mapping{$embed_file} eq $embed_file) {
                   9665:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   9666:         }
                   9667:         $upload_output .= '</td><td>';
1.1071    raeburn  9668:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.660     raeburn  9669:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  9670:             $numremref++;
1.660     raeburn  9671:         } elsif ($args->{'error_on_invalid_names'}
                   9672:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987     raeburn  9673:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   9674:             $numinvalid++;
1.660     raeburn  9675:         } else {
1.1071    raeburn  9676:             $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  9677:                                                      $embed_file,\%mapping,
1.1071    raeburn  9678:                                                      $allfiles,$codebase,'upload');
                   9679:             $counter ++;
                   9680:             $numnew ++;
1.987     raeburn  9681:         }
                   9682:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   9683:     }
                   9684:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  9685:         if ($actionurl eq '/adm/dependencies') {
                   9686:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   9687:             $modify_output .= &start_data_table_row().
                   9688:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   9689:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   9690:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   9691:                               '<td>'.$size.'</td>'.
                   9692:                               '<td>'.$mtime.'</td>'.
                   9693:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   9694:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   9695:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   9696:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   9697:                               &embedded_file_element('upload_embedded',$counter,
                   9698:                                                      $embed_file,\%mapping,
                   9699:                                                      $allfiles,$codebase,'modify').
                   9700:                               '</div></td>'.
                   9701:                               &end_data_table_row()."\n";
                   9702:             $counter ++;
                   9703:         } else {
                   9704:             $upload_output .= &start_data_table_row().
                   9705:                               '<td><span class="LC_filename">'.$embed_file.'</span></td>';
                   9706:                               '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   9707:                               &Apache::loncommon::end_data_table_row()."\n";
                   9708:         }
                   9709:     }
                   9710:     my $delidx = $counter;
                   9711:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   9712:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   9713:         $delete_output .= &start_data_table_row().
                   9714:                           '<td><img src="'.&icon($oldfile).'" />'.
                   9715:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   9716:                           '<td>'.$size.'</td>'.
                   9717:                           '<td>'.$mtime.'</td>'.
                   9718:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   9719:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   9720:                           &embedded_file_element('upload_embedded',$delidx,
                   9721:                                                  $oldfile,\%mapping,$allfiles,
                   9722:                                                  $codebase,'delete').'</td>'.
                   9723:                           &end_data_table_row()."\n"; 
                   9724:         $numunused ++;
                   9725:         $delidx ++;
1.987     raeburn  9726:     }
                   9727:     if ($upload_output) {
                   9728:         $upload_output = &start_data_table().
                   9729:                          $upload_output.
                   9730:                          &end_data_table()."\n";
                   9731:     }
1.1071    raeburn  9732:     if ($modify_output) {
                   9733:         $modify_output = &start_data_table().
                   9734:                          &start_data_table_header_row().
                   9735:                          '<th>'.&mt('File').'</th>'.
                   9736:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9737:                          '<th>'.&mt('Modified').'</th>'.
                   9738:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   9739:                          &end_data_table_header_row().
                   9740:                          $modify_output.
                   9741:                          &end_data_table()."\n";
                   9742:     }
                   9743:     if ($delete_output) {
                   9744:         $delete_output = &start_data_table().
                   9745:                          &start_data_table_header_row().
                   9746:                          '<th>'.&mt('File').'</th>'.
                   9747:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9748:                          '<th>'.&mt('Modified').'</th>'.
                   9749:                          '<th>'.&mt('Delete?').'</th>'.
                   9750:                          &end_data_table_header_row().
                   9751:                          $delete_output.
                   9752:                          &end_data_table()."\n";
                   9753:     }
1.987     raeburn  9754:     my $applies = 0;
                   9755:     if ($numremref) {
                   9756:         $applies ++;
                   9757:     }
                   9758:     if ($numinvalid) {
                   9759:         $applies ++;
                   9760:     }
                   9761:     if ($numexisting) {
                   9762:         $applies ++;
                   9763:     }
1.1071    raeburn  9764:     if ($counter || $numunused) {
1.987     raeburn  9765:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   9766:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  9767:                   $state.'<h3>'.$heading.'</h3>'; 
                   9768:         if ($actionurl eq '/adm/dependencies') {
                   9769:             if ($numnew) {
                   9770:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   9771:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   9772:                            $upload_output.'<br />'."\n";
                   9773:             }
                   9774:             if ($numexisting) {
                   9775:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   9776:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   9777:                            $modify_output.'<br />'."\n";
                   9778:                            $buttontext = &mt('Save changes');
                   9779:             }
                   9780:             if ($numunused) {
                   9781:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   9782:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   9783:                            $delete_output.'<br />'."\n";
                   9784:                            $buttontext = &mt('Save changes');
                   9785:             }
                   9786:         } else {
                   9787:             $output .= $upload_output.'<br />'."\n";
                   9788:         }
                   9789:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   9790:                    $counter.'" />'."\n";
                   9791:         if ($actionurl eq '/adm/dependencies') { 
                   9792:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   9793:                        $numnew.'" />'."\n";
                   9794:         } elsif ($actionurl eq '') {
1.987     raeburn  9795:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   9796:         }
                   9797:     } elsif ($applies) {
                   9798:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   9799:         if ($applies > 1) {
                   9800:             $output .=  
                   9801:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   9802:             if ($numremref) {
                   9803:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   9804:             }
                   9805:             if ($numinvalid) {
                   9806:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   9807:             }
                   9808:             if ($numexisting) {
                   9809:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   9810:             }
                   9811:             $output .= '</ul><br />';
                   9812:         } elsif ($numremref) {
                   9813:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   9814:         } elsif ($numinvalid) {
                   9815:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   9816:         } elsif ($numexisting) {
                   9817:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   9818:         }
                   9819:         $output .= $upload_output.'<br />';
                   9820:     }
                   9821:     my ($pathchange_output,$chgcount);
1.1071    raeburn  9822:     $chgcount = $counter;
1.987     raeburn  9823:     if (keys(%pathchanges) > 0) {
                   9824:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  9825:             if ($counter) {
1.987     raeburn  9826:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   9827:                                                   $embed_file,\%mapping,
1.1071    raeburn  9828:                                                   $allfiles,$codebase,'change');
1.987     raeburn  9829:             } else {
                   9830:                 $pathchange_output .= 
                   9831:                     &start_data_table_row().
                   9832:                     '<td><input type ="checkbox" name="namechange" value="'.
                   9833:                     $chgcount.'" checked="checked" /></td>'.
                   9834:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   9835:                     '<td>'.$embed_file.
                   9836:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  9837:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  9838:                     '</td>'.&end_data_table_row();
1.660     raeburn  9839:             }
1.987     raeburn  9840:             $numpathchg ++;
                   9841:             $chgcount ++;
1.660     raeburn  9842:         }
                   9843:     }
1.1071    raeburn  9844:     if ($counter) {
1.987     raeburn  9845:         if ($numpathchg) {
                   9846:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9847:                        $numpathchg.'" />'."\n";
                   9848:         }
                   9849:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9850:             ($actionurl eq '/adm/imsimport')) {
                   9851:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9852:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9853:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  9854:         } elsif ($actionurl eq '/adm/dependencies') {
                   9855:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  9856:         }
1.1071    raeburn  9857:         $output .=  '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  9858:     } elsif ($numpathchg) {
                   9859:         my %pathchange = ();
                   9860:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9861:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9862:             $output .= '<p>'.&mt('or').'</p>'; 
                   9863:         } 
                   9864:     }
1.1071    raeburn  9865:     return ($output,$counter,$numpathchg);
1.987     raeburn  9866: }
                   9867: 
                   9868: sub embedded_file_element {
1.1071    raeburn  9869:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  9870:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9871:                    (ref($codebase) eq 'HASH'));
                   9872:     my $output;
1.1071    raeburn  9873:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  9874:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9875:     }
                   9876:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9877:                &escape($embed_file).'" />';
                   9878:     unless (($context eq 'upload_embedded') && 
                   9879:             ($mapping->{$embed_file} eq $embed_file)) {
                   9880:         $output .='
                   9881:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9882:     }
                   9883:     my $attrib;
                   9884:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9885:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9886:     }
                   9887:     $output .=
                   9888:         "\n\t\t".
                   9889:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9890:         $attrib.'" />';
                   9891:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9892:         $output .=
                   9893:             "\n\t\t".
                   9894:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9895:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9896:     }
1.987     raeburn  9897:     return $output;
1.660     raeburn  9898: }
                   9899: 
1.1071    raeburn  9900: sub get_dependency_details {
                   9901:     my ($currfile,$currsubfile,$embed_file) = @_;
                   9902:     my ($size,$mtime,$showsize,$showmtime);
                   9903:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   9904:         if ($embed_file =~ m{/}) {
                   9905:             my ($path,$fname) = split(/\//,$embed_file);
                   9906:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   9907:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   9908:             }
                   9909:         } else {
                   9910:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   9911:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   9912:             }
                   9913:         }
                   9914:         $showsize = $size/1024.0;
                   9915:         $showsize = sprintf("%.1f",$showsize);
                   9916:         if ($mtime > 0) {
                   9917:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   9918:         }
                   9919:     }
                   9920:     return ($showsize,$showmtime);
                   9921: }
                   9922: 
                   9923: sub ask_embedded_js {
                   9924:     return <<"END";
                   9925: <script type="text/javascript"">
                   9926: // <![CDATA[
                   9927: function toggleBrowse(counter) {
                   9928:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   9929:     var fileid = document.getElementById('embedded_item_'+counter);
                   9930:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   9931:     if (chkboxid.checked == true) {
                   9932:         uploaddivid.style.display='block';
                   9933:     } else {
                   9934:         uploaddivid.style.display='none';
                   9935:         fileid.value = '';
                   9936:     }
                   9937: }
                   9938: // ]]>
                   9939: </script>
                   9940: 
                   9941: END
                   9942: }
                   9943: 
1.661     raeburn  9944: sub upload_embedded {
                   9945:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  9946:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   9947:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  9948:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   9949:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   9950:         my $orig_uploaded_filename =
                   9951:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  9952:         foreach my $type ('orig','ref','attrib','codebase') {
                   9953:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   9954:                 $env{'form.embedded_'.$type.'_'.$i} =
                   9955:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   9956:             }
                   9957:         }
1.661     raeburn  9958:         my ($path,$fname) =
                   9959:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   9960:         # no path, whole string is fname
                   9961:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   9962:         $fname = &Apache::lonnet::clean_filename($fname);
                   9963:         # See if there is anything left
                   9964:         next if ($fname eq '');
                   9965: 
                   9966:         # Check if file already exists as a file or directory.
                   9967:         my ($state,$msg);
                   9968:         if ($context eq 'portfolio') {
                   9969:             my $port_path = $dirpath;
                   9970:             if ($group ne '') {
                   9971:                 $port_path = "groups/$group/$port_path";
                   9972:             }
1.987     raeburn  9973:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   9974:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  9975:                                               $dir_root,$port_path,$disk_quota,
                   9976:                                               $current_disk_usage,$uname,$udom);
                   9977:             if ($state eq 'will_exceed_quota'
1.984     raeburn  9978:                 || $state eq 'file_locked') {
1.661     raeburn  9979:                 $output .= $msg;
                   9980:                 next;
                   9981:             }
                   9982:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   9983:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   9984:             if ($state eq 'exists') {
                   9985:                 $output .= $msg;
                   9986:                 next;
                   9987:             }
                   9988:         }
                   9989:         # Check if extension is valid
                   9990:         if (($fname =~ /\.(\w+)$/) &&
                   9991:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  9992:             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';
1.661     raeburn  9993:             next;
                   9994:         } elsif (($fname =~ /\.(\w+)$/) &&
                   9995:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  9996:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  9997:             next;
                   9998:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  9999:             $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661     raeburn  10000:             next;
                   10001:         }
                   10002:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   10003:         if ($context eq 'portfolio') {
1.984     raeburn  10004:             my $result;
                   10005:             if ($state eq 'existingfile') {
                   10006:                 $result=
                   10007:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  10008:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  10009:             } else {
1.984     raeburn  10010:                 $result=
                   10011:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10012:                                                     $dirpath.
                   10013:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  10014:                 if ($result !~ m|^/uploaded/|) {
                   10015:                     $output .= '<span class="LC_error">'
                   10016:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10017:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10018:                                .'</span><br />';
                   10019:                     next;
                   10020:                 } else {
1.987     raeburn  10021:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10022:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10023:                 }
1.661     raeburn  10024:             }
1.987     raeburn  10025:         } elsif ($context eq 'coursedoc') {
                   10026:             my $result =
                   10027:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   10028:                                                 $dirpath.'/'.$path);
                   10029:             if ($result !~ m|^/uploaded/|) {
                   10030:                 $output .= '<span class="LC_error">'
                   10031:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10032:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10033:                            .'</span><br />';
                   10034:                     next;
                   10035:             } else {
                   10036:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10037:                            $path.$fname.'</span>').'<br />';
                   10038:             }
1.661     raeburn  10039:         } else {
                   10040: # Save the file
                   10041:             my $target = $env{'form.embedded_item_'.$i};
                   10042:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10043:             my $dest = $fullpath.$fname;
                   10044:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10045:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10046:             my $count;
                   10047:             my $filepath = $dir_root;
1.1027    raeburn  10048:             foreach my $subdir (@parts) {
                   10049:                 $filepath .= "/$subdir";
                   10050:                 if (!-e $filepath) {
1.661     raeburn  10051:                     mkdir($filepath,0770);
                   10052:                 }
                   10053:             }
                   10054:             my $fh;
                   10055:             if (!open($fh,'>'.$dest)) {
                   10056:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10057:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10058:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10059:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10060:                            '</span><br />';
                   10061:             } else {
                   10062:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10063:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10064:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10065:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10066:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10067:                               '</span><br />';
                   10068:                 } else {
1.987     raeburn  10069:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10070:                                $url.'</span>').'<br />';
                   10071:                     unless ($context eq 'testbank') {
                   10072:                         $footer .= &mt('View embedded file: [_1]',
                   10073:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10074:                     }
                   10075:                 }
                   10076:                 close($fh);
                   10077:             }
                   10078:         }
                   10079:         if ($env{'form.embedded_ref_'.$i}) {
                   10080:             $pathchange{$i} = 1;
                   10081:         }
                   10082:     }
                   10083:     if ($output) {
                   10084:         $output = '<p>'.$output.'</p>';
                   10085:     }
                   10086:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10087:     $returnflag = 'ok';
1.1071    raeburn  10088:     my $numpathchgs = scalar(keys(%pathchange));
                   10089:     if ($numpathchgs > 0) {
1.987     raeburn  10090:         if ($context eq 'portfolio') {
                   10091:             $output .= '<p>'.&mt('or').'</p>';
                   10092:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10093:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10094:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10095:             $returnflag = 'modify_orightml';
                   10096:         }
                   10097:     }
1.1071    raeburn  10098:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10099: }
                   10100: 
                   10101: sub modify_html_form {
                   10102:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10103:     my $end = 0;
                   10104:     my $modifyform;
                   10105:     if ($context eq 'upload_embedded') {
                   10106:         return unless (ref($pathchange) eq 'HASH');
                   10107:         if ($env{'form.number_embedded_items'}) {
                   10108:             $end += $env{'form.number_embedded_items'};
                   10109:         }
                   10110:         if ($env{'form.number_pathchange_items'}) {
                   10111:             $end += $env{'form.number_pathchange_items'};
                   10112:         }
                   10113:         if ($end) {
                   10114:             for (my $i=0; $i<$end; $i++) {
                   10115:                 if ($i < $env{'form.number_embedded_items'}) {
                   10116:                     next unless($pathchange->{$i});
                   10117:                 }
                   10118:                 $modifyform .=
                   10119:                     &start_data_table_row().
                   10120:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10121:                     'checked="checked" /></td>'.
                   10122:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10123:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10124:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10125:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10126:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10127:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10128:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10129:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10130:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10131:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10132:                     &end_data_table_row();
1.1071    raeburn  10133:             }
1.987     raeburn  10134:         }
                   10135:     } else {
                   10136:         $modifyform = $pathchgtable;
                   10137:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10138:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10139:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10140:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10141:         }
                   10142:     }
                   10143:     if ($modifyform) {
1.1071    raeburn  10144:         if ($actionurl eq '/adm/dependencies') {
                   10145:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10146:         }
1.987     raeburn  10147:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10148:                '<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".
                   10149:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10150:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10151:                '</ol></p>'."\n".'<p>'.
                   10152:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10153:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10154:                &start_data_table()."\n".
                   10155:                &start_data_table_header_row().
                   10156:                '<th>'.&mt('Change?').'</th>'.
                   10157:                '<th>'.&mt('Current reference').'</th>'.
                   10158:                '<th>'.&mt('Required reference').'</th>'.
                   10159:                &end_data_table_header_row()."\n".
                   10160:                $modifyform.
                   10161:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10162:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10163:                '</form>'."\n";
                   10164:     }
                   10165:     return;
                   10166: }
                   10167: 
                   10168: sub modify_html_refs {
                   10169:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   10170:     my $container;
                   10171:     if ($context eq 'portfolio') {
                   10172:         $container = $env{'form.container'};
                   10173:     } elsif ($context eq 'coursedoc') {
                   10174:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10175:     } elsif ($context eq 'manage_dependencies') {
                   10176:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10177:         $container = "/$container";
1.987     raeburn  10178:     } else {
1.1027    raeburn  10179:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10180:     }
                   10181:     my (%allfiles,%codebase,$output,$content);
                   10182:     my @changes = &get_env_multiple('form.namechange');
1.1071    raeburn  10183:     unless (@changes > 0) {
                   10184:         if (wantarray) {
                   10185:             return ('',0,0); 
                   10186:         } else {
                   10187:             return;
                   10188:         }
                   10189:     }
                   10190:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10191:         ($context eq 'manage_dependencies')) {
                   10192:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10193:             if (wantarray) {
                   10194:                 return ('',0,0);
                   10195:             } else {
                   10196:                 return;
                   10197:             }
                   10198:         } 
1.987     raeburn  10199:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10200:         if ($content eq '-1') {
                   10201:             if (wantarray) {
                   10202:                 return ('',0,0);
                   10203:             } else {
                   10204:                 return;
                   10205:             }
                   10206:         }
1.987     raeburn  10207:     } else {
1.1071    raeburn  10208:         unless ($container =~ /^\Q$dir_root\E/) {
                   10209:             if (wantarray) {
                   10210:                 return ('',0,0);
                   10211:             } else {
                   10212:                 return;
                   10213:             }
                   10214:         } 
1.987     raeburn  10215:         if (open(my $fh,"<$container")) {
                   10216:             $content = join('', <$fh>);
                   10217:             close($fh);
                   10218:         } else {
1.1071    raeburn  10219:             if (wantarray) {
                   10220:                 return ('',0,0);
                   10221:             } else {
                   10222:                 return;
                   10223:             }
1.987     raeburn  10224:         }
                   10225:     }
                   10226:     my ($count,$codebasecount) = (0,0);
                   10227:     my $mm = new File::MMagic;
                   10228:     my $mime_type = $mm->checktype_contents($content);
                   10229:     if ($mime_type eq 'text/html') {
                   10230:         my $parse_result = 
                   10231:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10232:                                                     \%codebase,\$content);
                   10233:         if ($parse_result eq 'ok') {
                   10234:             foreach my $i (@changes) {
                   10235:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10236:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10237:                 if ($allfiles{$ref}) {
                   10238:                     my $newname =  $orig;
                   10239:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10240:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10241:                     if ($attrib_regexp =~ /:/) {
                   10242:                         $attrib_regexp =~ s/\:/|/g;
                   10243:                     }
                   10244:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10245:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10246:                         $count += $numchg;
                   10247:                     }
                   10248:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10249:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10250:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10251:                         $codebasecount ++;
                   10252:                     }
                   10253:                 }
                   10254:             }
                   10255:             if ($count || $codebasecount) {
                   10256:                 my $saveresult;
1.1071    raeburn  10257:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10258:                     ($context eq 'manage_dependencies')) {
1.987     raeburn  10259:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10260:                     if ($url eq $container) {
                   10261:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10262:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10263:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10264:                                             $fname.'</span>').'</p>';
1.987     raeburn  10265:                     } else {
                   10266:                          $output = '<p class="LC_error">'.
                   10267:                                    &mt('Error: update failed for: [_1].',
                   10268:                                    '<span class="LC_filename">'.
                   10269:                                    $container.'</span>').'</p>';
                   10270:                     }
                   10271:                 } else {
                   10272:                     if (open(my $fh,">$container")) {
                   10273:                         print $fh $content;
                   10274:                         close($fh);
                   10275:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10276:                                   $count,'<span class="LC_filename">'.
                   10277:                                   $container.'</span>').'</p>';
1.661     raeburn  10278:                     } else {
1.987     raeburn  10279:                          $output = '<p class="LC_error">'.
                   10280:                                    &mt('Error: could not update [_1].',
                   10281:                                    '<span class="LC_filename">'.
                   10282:                                    $container.'</span>').'</p>';
1.661     raeburn  10283:                     }
                   10284:                 }
                   10285:             }
1.987     raeburn  10286:         } else {
                   10287:             &logthis('Failed to parse '.$container.
                   10288:                      ' to modify references: '.$parse_result);
1.661     raeburn  10289:         }
                   10290:     }
1.1071    raeburn  10291:     if (wantarray) {
                   10292:         return ($output,$count,$codebasecount);
                   10293:     } else {
                   10294:         return $output;
                   10295:     }
1.661     raeburn  10296: }
                   10297: 
                   10298: sub check_for_existing {
                   10299:     my ($path,$fname,$element) = @_;
                   10300:     my ($state,$msg);
                   10301:     if (-d $path.'/'.$fname) {
                   10302:         $state = 'exists';
                   10303:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10304:     } elsif (-e $path.'/'.$fname) {
                   10305:         $state = 'exists';
                   10306:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10307:     }
                   10308:     if ($state eq 'exists') {
                   10309:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10310:     }
                   10311:     return ($state,$msg);
                   10312: }
                   10313: 
                   10314: sub check_for_upload {
                   10315:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10316:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10317:     my $filesize = length($env{'form.'.$element});
                   10318:     if (!$filesize) {
                   10319:         my $msg = '<span class="LC_error">'.
                   10320:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10321:                       '<span class="LC_filename">'.$fname.'</span>',
                   10322:                       $filesize).'<br />'.
1.1007    raeburn  10323:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10324:                   '</span>';
                   10325:         return ('zero_bytes',$msg);
                   10326:     }
                   10327:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10328:     my $getpropath = 1;
1.1021    raeburn  10329:     my ($dirlistref,$listerror) =
                   10330:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10331:     my $found_file = 0;
                   10332:     my $locked_file = 0;
1.991     raeburn  10333:     my @lockers;
                   10334:     my $navmap;
                   10335:     if ($env{'request.course.id'}) {
                   10336:         $navmap = Apache::lonnavmaps::navmap->new();
                   10337:     }
1.1021    raeburn  10338:     if (ref($dirlistref) eq 'ARRAY') {
                   10339:         foreach my $line (@{$dirlistref}) {
                   10340:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10341:             if ($file_name eq $fname){
                   10342:                 $file_name = $path.$file_name;
                   10343:                 if ($group ne '') {
                   10344:                     $file_name = $group.$file_name;
                   10345:                 }
                   10346:                 $found_file = 1;
                   10347:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10348:                     foreach my $lock (@lockers) {
                   10349:                         if (ref($lock) eq 'ARRAY') {
                   10350:                             my ($symb,$crsid) = @{$lock};
                   10351:                             if ($crsid eq $env{'request.course.id'}) {
                   10352:                                 if (ref($navmap)) {
                   10353:                                     my $res = $navmap->getBySymb($symb);
                   10354:                                     foreach my $part (@{$res->parts()}) { 
                   10355:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10356:                                         unless (($slot_status == $res->RESERVED) ||
                   10357:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10358:                                             $locked_file = 1;
                   10359:                                         }
1.991     raeburn  10360:                                     }
1.1021    raeburn  10361:                                 } else {
                   10362:                                     $locked_file = 1;
1.991     raeburn  10363:                                 }
                   10364:                             } else {
                   10365:                                 $locked_file = 1;
                   10366:                             }
                   10367:                         }
1.1021    raeburn  10368:                    }
                   10369:                 } else {
                   10370:                     my @info = split(/\&/,$rest);
                   10371:                     my $currsize = $info[6]/1000;
                   10372:                     if ($currsize < $filesize) {
                   10373:                         my $extra = $filesize - $currsize;
                   10374:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10375:                             my $msg = '<span class="LC_error">'.
                   10376:                                       &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.',
                   10377:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10378:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10379:                                                    $disk_quota,$current_disk_usage);
                   10380:                             return ('will_exceed_quota',$msg);
                   10381:                         }
1.984     raeburn  10382:                     }
                   10383:                 }
1.661     raeburn  10384:             }
                   10385:         }
                   10386:     }
                   10387:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10388:         my $msg = '<span class="LC_error">'.
                   10389:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10390:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10391:         return ('will_exceed_quota',$msg);
                   10392:     } elsif ($found_file) {
                   10393:         if ($locked_file) {
                   10394:             my $msg = '<span class="LC_error">';
                   10395:             $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>');
                   10396:             $msg .= '</span><br />';
                   10397:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10398:             return ('file_locked',$msg);
                   10399:         } else {
                   10400:             my $msg = '<span class="LC_error">';
1.984     raeburn  10401:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.661     raeburn  10402:             $msg .= '</span>';
1.984     raeburn  10403:             return ('existingfile',$msg);
1.661     raeburn  10404:         }
                   10405:     }
                   10406: }
                   10407: 
1.987     raeburn  10408: sub check_for_traversal {
                   10409:     my ($path,$url,$toplevel) = @_;
                   10410:     my @parts=split(/\//,$path);
                   10411:     my $cleanpath;
                   10412:     my $fullpath = $url;
                   10413:     for (my $i=0;$i<@parts;$i++) {
                   10414:         next if ($parts[$i] eq '.');
                   10415:         if ($parts[$i] eq '..') {
                   10416:             $fullpath =~ s{([^/]+/)$}{};
                   10417:         } else {
                   10418:             $fullpath .= $parts[$i].'/';
                   10419:         }
                   10420:     }
                   10421:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10422:         $cleanpath = $1;
                   10423:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10424:         my $curr_toprel = $1;
                   10425:         my @parts = split(/\//,$curr_toprel);
                   10426:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10427:         my @urlparts = split(/\//,$url_toprel);
                   10428:         my $doubledots;
                   10429:         my $startdiff = -1;
                   10430:         for (my $i=0; $i<@urlparts; $i++) {
                   10431:             if ($startdiff == -1) {
                   10432:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10433:                     $startdiff = $i;
                   10434:                     $doubledots .= '../';
                   10435:                 }
                   10436:             } else {
                   10437:                 $doubledots .= '../';
                   10438:             }
                   10439:         }
                   10440:         if ($startdiff > -1) {
                   10441:             $cleanpath = $doubledots;
                   10442:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10443:                 $cleanpath .= $parts[$i].'/';
                   10444:             }
                   10445:         }
                   10446:     }
                   10447:     $cleanpath =~ s{(/)$}{};
                   10448:     return $cleanpath;
                   10449: }
1.31      albertel 10450: 
1.1053    raeburn  10451: sub is_archive_file {
                   10452:     my ($mimetype) = @_;
                   10453:     if (($mimetype eq 'application/octet-stream') ||
                   10454:         ($mimetype eq 'application/x-stuffit') ||
                   10455:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10456:         return 1;
                   10457:     }
                   10458:     return;
                   10459: }
                   10460: 
                   10461: sub decompress_form {
1.1065    raeburn  10462:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10463:     my %lt = &Apache::lonlocal::texthash (
                   10464:         this => 'This file is an archive file.',
1.1067    raeburn  10465:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10466:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10467:         youm => 'You may wish to extract its contents.',
                   10468:         extr => 'Extract contents',
1.1067    raeburn  10469:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10470:         proa => 'Process automatically?',
1.1053    raeburn  10471:         yes  => 'Yes',
                   10472:         no   => 'No',
1.1067    raeburn  10473:         fold => 'Title for folder containing movie',
                   10474:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10475:     );
1.1065    raeburn  10476:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10477:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10478:     my $info = &list_archive_contents($fileloc,\@paths);
                   10479:     if (@paths) {
                   10480:         foreach my $path (@paths) {
                   10481:             $path =~ s{^/}{};
1.1067    raeburn  10482:             if ($path =~ m{^([^/]+)/$}) {
                   10483:                 $topdir = $1;
                   10484:             }
1.1065    raeburn  10485:             if ($path =~ m{^([^/]+)/}) {
                   10486:                 $toplevel{$1} = $path;
                   10487:             } else {
                   10488:                 $toplevel{$path} = $path;
                   10489:             }
                   10490:         }
                   10491:     }
1.1067    raeburn  10492:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10493:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10494:                         "$topdir/media/",
                   10495:                         "$topdir/media/$topdir.mp4",
                   10496:                         "$topdir/media/FirstFrame.png",
                   10497:                         "$topdir/media/player.swf",
                   10498:                         "$topdir/media/swfobject.js",
                   10499:                         "$topdir/media/expressInstall.swf");
                   10500:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10501:         if (@diffs == 0) {
                   10502:             $is_camtasia = 1;
                   10503:         }
                   10504:     }
                   10505:     my $output;
                   10506:     if ($is_camtasia) {
                   10507:         $output = <<"ENDCAM";
                   10508: <script type="text/javascript" language="Javascript">
                   10509: // <![CDATA[
                   10510: 
                   10511: function camtasiaToggle() {
                   10512:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10513:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10514:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10515: 
                   10516:                 document.getElementById('camtasia_titles').style.display='block';
                   10517:             } else {
                   10518:                 document.getElementById('camtasia_titles').style.display='none';
                   10519:             }
                   10520:         }
                   10521:     }
                   10522:     return;
                   10523: }
                   10524: 
                   10525: // ]]>
                   10526: </script>
                   10527: <p>$lt{'camt'}</p>
                   10528: ENDCAM
1.1065    raeburn  10529:     } else {
1.1067    raeburn  10530:         $output = '<p>'.$lt{'this'};
                   10531:         if ($info eq '') {
                   10532:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   10533:         } else {
                   10534:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   10535:                        '<div><pre>'.$info.'</pre></div>';
                   10536:         }
1.1065    raeburn  10537:     }
1.1067    raeburn  10538:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  10539:     my $duplicates;
                   10540:     my $num = 0;
                   10541:     if (ref($dirlist) eq 'ARRAY') {
                   10542:         foreach my $item (@{$dirlist}) {
                   10543:             if (ref($item) eq 'ARRAY') {
                   10544:                 if (exists($toplevel{$item->[0]})) {
                   10545:                     $duplicates .= 
                   10546:                         &start_data_table_row().
                   10547:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10548:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   10549:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10550:                         'value="1" />'.&mt('Yes').'</label>'.
                   10551:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   10552:                         '<td>'.$item->[0].'</td>';
                   10553:                     if ($item->[2]) {
                   10554:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   10555:                     } else {
                   10556:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   10557:                     }
                   10558:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   10559:                                    '<td>'.
                   10560:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   10561:                                    '</td>'.
                   10562:                                    &end_data_table_row();
                   10563:                     $num ++;
                   10564:                 }
                   10565:             }
                   10566:         }
                   10567:     }
                   10568:     my $itemcount;
                   10569:     if (@paths > 0) {
                   10570:         $itemcount = scalar(@paths);
                   10571:     } else {
                   10572:         $itemcount = 1;
                   10573:     }
1.1067    raeburn  10574:     if ($is_camtasia) {
                   10575:         $output .= $lt{'auto'}.'<br />'.
                   10576:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   10577:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   10578:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   10579:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   10580:                    $lt{'no'}.'</label></span><br />'.
                   10581:                    '<div id="camtasia_titles" style="display:block">'.
                   10582:                    &Apache::lonhtmlcommon::start_pick_box().
                   10583:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   10584:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   10585:                    &Apache::lonhtmlcommon::row_closure().
                   10586:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   10587:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   10588:                    &Apache::lonhtmlcommon::row_closure(1).
                   10589:                    &Apache::lonhtmlcommon::end_pick_box().
                   10590:                    '</div>';
                   10591:     }
1.1065    raeburn  10592:     $output .= 
                   10593:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  10594:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   10595:         "\n";
1.1065    raeburn  10596:     if ($duplicates ne '') {
                   10597:         $output .= '<p><span class="LC_warning">'.
                   10598:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   10599:                    &start_data_table().
                   10600:                    &start_data_table_header_row().
                   10601:                    '<th>'.&mt('Overwrite?').'</th>'.
                   10602:                    '<th>'.&mt('Name').'</th>'.
                   10603:                    '<th>'.&mt('Type').'</th>'.
                   10604:                    '<th>'.&mt('Size').'</th>'.
                   10605:                    '<th>'.&mt('Last modified').'</th>'.
                   10606:                    &end_data_table_header_row().
                   10607:                    $duplicates.
                   10608:                    &end_data_table().
                   10609:                    '</p>';
                   10610:     }
1.1067    raeburn  10611:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  10612:     if (ref($hiddenelements) eq 'HASH') {
                   10613:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   10614:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   10615:         }
                   10616:     }
                   10617:     $output .= <<"END";
1.1067    raeburn  10618: <br />
1.1053    raeburn  10619: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   10620: </form>
                   10621: $noextract
                   10622: END
                   10623:     return $output;
                   10624: }
                   10625: 
1.1065    raeburn  10626: sub decompression_utility {
                   10627:     my ($program) = @_;
                   10628:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   10629:     my $location;
                   10630:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   10631:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   10632:                          '/usr/sbin/') {
                   10633:             if (-x $dir.$program) {
                   10634:                 $location = $dir.$program;
                   10635:                 last;
                   10636:             }
                   10637:         }
                   10638:     }
                   10639:     return $location;
                   10640: }
                   10641: 
                   10642: sub list_archive_contents {
                   10643:     my ($file,$pathsref) = @_;
                   10644:     my (@cmd,$output);
                   10645:     my $needsregexp;
                   10646:     if ($file =~ /\.zip$/) {
                   10647:         @cmd = (&decompression_utility('unzip'),"-l");
                   10648:         $needsregexp = 1;
                   10649:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   10650:              ($file =~ /\.tgz$/)) {
                   10651:         @cmd = (&decompression_utility('tar'),"-ztf");
                   10652:     } elsif ($file =~ /\.tar\.bz2$/) {
                   10653:         @cmd = (&decompression_utility('tar'),"-jtf");
                   10654:     } elsif ($file =~ m|\.tar$|) {
                   10655:         @cmd = (&decompression_utility('tar'),"-tf");
                   10656:     }
                   10657:     if (@cmd) {
                   10658:         undef($!);
                   10659:         undef($@);
                   10660:         if (open(my $fh,"-|", @cmd, $file)) {
                   10661:             while (my $line = <$fh>) {
                   10662:                 $output .= $line;
                   10663:                 chomp($line);
                   10664:                 my $item;
                   10665:                 if ($needsregexp) {
                   10666:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   10667:                 } else {
                   10668:                     $item = $line;
                   10669:                 }
                   10670:                 if ($item ne '') {
                   10671:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   10672:                         push(@{$pathsref},$item);
                   10673:                     } 
                   10674:                 }
                   10675:             }
                   10676:             close($fh);
                   10677:         }
                   10678:     }
                   10679:     return $output;
                   10680: }
                   10681: 
1.1053    raeburn  10682: sub decompress_uploaded_file {
                   10683:     my ($file,$dir) = @_;
                   10684:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   10685:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   10686:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   10687:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   10688:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   10689:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   10690:     my $decompressed = $env{'cgi.decompressed'};
                   10691:     &Apache::lonnet::delenv('cgi.file');
                   10692:     &Apache::lonnet::delenv('cgi.dir');
                   10693:     &Apache::lonnet::delenv('cgi.decompressed');
                   10694:     return ($decompressed,$result);
                   10695: }
                   10696: 
1.1055    raeburn  10697: sub process_decompression {
                   10698:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   10699:     my ($dir,$error,$warning,$output);
                   10700:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
                   10701:         $error = &mt('File name not a supported archive file type.').
                   10702:                  '<br />'.&mt('File name should end with one of: [_1].',
                   10703:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   10704:     } else {
                   10705:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   10706:         if ($docuhome eq 'no_host') {
                   10707:             $error = &mt('Could not determine home server for course.');
                   10708:         } else {
                   10709:             my @ids=&Apache::lonnet::current_machine_ids();
                   10710:             my $currdir = "$dir_root/$destination";
                   10711:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   10712:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   10713:                        "$dir_root/$destination";
                   10714:             } else {
                   10715:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   10716:                        "$dir_root/$docudom/$docuname/$destination";
                   10717:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   10718:                     $error = &mt('Archive file not found.');
                   10719:                 }
                   10720:             }
1.1065    raeburn  10721:             my (@to_overwrite,@to_skip);
                   10722:             if ($env{'form.archive_overwrite_total'} > 0) {
                   10723:                 my $total = $env{'form.archive_overwrite_total'};
                   10724:                 for (my $i=0; $i<$total; $i++) {
                   10725:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   10726:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   10727:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   10728:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   10729:                     }
                   10730:                 }
                   10731:             }
                   10732:             my $numskip = scalar(@to_skip);
                   10733:             if (($numskip > 0) && 
                   10734:                 ($numskip == $env{'form.archive_itemcount'})) {
                   10735:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   10736:             } elsif ($dir eq '') {
1.1055    raeburn  10737:                 $error = &mt('Directory containing archive file unavailable.');
                   10738:             } elsif (!$error) {
1.1065    raeburn  10739:                 my ($decompressed,$display);
                   10740:                 if ($numskip > 0) {
                   10741:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   10742:                     mkdir("$dir/$tempdir",0755);
                   10743:                     system("mv $dir/$file $dir/$tempdir/$file");
                   10744:                     ($decompressed,$display) = 
                   10745:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   10746:                     foreach my $item (@to_skip) {
                   10747:                         if (($item ne '') && ($item !~ /\.\./)) {
                   10748:                             if (-f "$dir/$tempdir/$item") { 
                   10749:                                 unlink("$dir/$tempdir/$item");
                   10750:                             } elsif (-d "$dir/$tempdir/$item") {
                   10751:                                 system("rm -rf $dir/$tempdir/$item");
                   10752:                             }
                   10753:                         }
                   10754:                     }
                   10755:                     system("mv $dir/$tempdir/* $dir");
                   10756:                     rmdir("$dir/$tempdir");   
                   10757:                 } else {
                   10758:                     ($decompressed,$display) = 
                   10759:                         &decompress_uploaded_file($file,$dir);
                   10760:                 }
1.1055    raeburn  10761:                 if ($decompressed eq 'ok') {
1.1065    raeburn  10762:                     $output = '<p class="LC_info">'.
                   10763:                               &mt('Files extracted successfully from archive.').
                   10764:                               '</p>'."\n";
1.1055    raeburn  10765:                     my ($warning,$result,@contents);
                   10766:                     my ($newdirlistref,$newlisterror) =
                   10767:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   10768:                                                  $docuname,1);
                   10769:                     my (%is_dir,%changes,@newitems);
                   10770:                     my $dirptr = 16384;
1.1065    raeburn  10771:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  10772:                         foreach my $dir_line (@{$newdirlistref}) {
                   10773:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  10774:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   10775:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  10776:                                 push(@newitems,$item);
                   10777:                                 if ($dirptr&$testdir) {
                   10778:                                     $is_dir{$item} = 1;
                   10779:                                 }
                   10780:                                 $changes{$item} = 1;
                   10781:                             }
                   10782:                         }
                   10783:                     }
                   10784:                     if (keys(%changes) > 0) {
                   10785:                         foreach my $item (sort(@newitems)) {
                   10786:                             if ($changes{$item}) {
                   10787:                                 push(@contents,$item);
                   10788:                             }
                   10789:                         }
                   10790:                     }
                   10791:                     if (@contents > 0) {
1.1067    raeburn  10792:                         my $wantform;
                   10793:                         unless ($env{'form.autoextract_camtasia'}) {
                   10794:                             $wantform = 1;
                   10795:                         }
1.1056    raeburn  10796:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  10797:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   10798:                                                                 $currdir,\%is_dir,
                   10799:                                                                 \%children,\%parent,
1.1056    raeburn  10800:                                                                 \@contents,\%dirorder,
                   10801:                                                                 \%titles,$wantform);
1.1055    raeburn  10802:                         if ($datatable ne '') {
                   10803:                             $output .= &archive_options_form('decompressed',$datatable,
                   10804:                                                              $count,$hiddenelem);
1.1065    raeburn  10805:                             my $startcount = 6;
1.1055    raeburn  10806:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  10807:                                                            \%titles,\%children);
1.1055    raeburn  10808:                         }
1.1067    raeburn  10809:                         if ($env{'form.autoextract_camtasia'}) {
                   10810:                             my %displayed;
                   10811:                             my $total = 1;
                   10812:                             $env{'form.archive_directory'} = [];
                   10813:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   10814:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   10815:                                 $path =~ s{/$}{};
                   10816:                                 my $item;
                   10817:                                 if ($path ne '') {
                   10818:                                     $item = "$path/$titles{$i}";
                   10819:                                 } else {
                   10820:                                     $item = $titles{$i};
                   10821:                                 }
                   10822:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   10823:                                 if ($item eq $contents[0]) {
                   10824:                                     push(@{$env{'form.archive_directory'}},$i);
                   10825:                                     $env{'form.archive_'.$i} = 'display';
                   10826:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   10827:                                     $displayed{'folder'} = $i;
                   10828:                                 } elsif ($item eq "$contents[0]/index.html") {
                   10829:                                     $env{'form.archive_'.$i} = 'display';
                   10830:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   10831:                                     $displayed{'web'} = $i;
                   10832:                                 } else {
                   10833:                                     if ($item eq "$contents[0]/media") {
                   10834:                                         push(@{$env{'form.archive_directory'}},$i);
                   10835:                                     }
                   10836:                                     $env{'form.archive_'.$i} = 'dependency';
                   10837:                                 }
                   10838:                                 $total ++;
                   10839:                             }
                   10840:                             for (my $i=1; $i<$total; $i++) {
                   10841:                                 next if ($i == $displayed{'web'});
                   10842:                                 next if ($i == $displayed{'folder'});
                   10843:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   10844:                             }
                   10845:                             $env{'form.phase'} = 'decompress_cleanup';
                   10846:                             $env{'form.archivedelete'} = 1;
                   10847:                             $env{'form.archive_count'} = $total-1;
                   10848:                             $output .=
                   10849:                                 &process_extracted_files('coursedocs',$docudom,
                   10850:                                                          $docuname,$destination,
                   10851:                                                          $dir_root,$hiddenelem);
                   10852:                         }
1.1055    raeburn  10853:                     } else {
                   10854:                         $warning = &mt('No new items extracted from archive file.');
                   10855:                     }
                   10856:                 } else {
                   10857:                     $output = $display;
                   10858:                     $error = &mt('An error occurred during extraction from the archive file.');
                   10859:                 }
                   10860:             }
                   10861:         }
                   10862:     }
                   10863:     if ($error) {
                   10864:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   10865:                    $error.'</p>'."\n";
                   10866:     }
                   10867:     if ($warning) {
                   10868:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   10869:     }
                   10870:     return $output;
                   10871: }
                   10872: 
                   10873: sub get_extracted {
1.1056    raeburn  10874:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   10875:         $titles,$wantform) = @_;
1.1055    raeburn  10876:     my $count = 0;
                   10877:     my $depth = 0;
                   10878:     my $datatable;
1.1056    raeburn  10879:     my @hierarchy;
1.1055    raeburn  10880:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  10881:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   10882:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  10883:     foreach my $item (@{$contents}) {
                   10884:         $count ++;
1.1056    raeburn  10885:         @{$dirorder->{$count}} = @hierarchy;
                   10886:         $titles->{$count} = $item;
1.1055    raeburn  10887:         &archive_hierarchy($depth,$count,$parent,$children);
                   10888:         if ($wantform) {
                   10889:             $datatable .= &archive_row($is_dir->{$item},$item,
                   10890:                                        $currdir,$depth,$count);
                   10891:         }
                   10892:         if ($is_dir->{$item}) {
                   10893:             $depth ++;
1.1056    raeburn  10894:             push(@hierarchy,$count);
                   10895:             $parent->{$depth} = $count;
1.1055    raeburn  10896:             $datatable .=
                   10897:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  10898:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   10899:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  10900:             $depth --;
1.1056    raeburn  10901:             pop(@hierarchy);
1.1055    raeburn  10902:         }
                   10903:     }
                   10904:     return ($count,$datatable);
                   10905: }
                   10906: 
                   10907: sub recurse_extracted_archive {
1.1056    raeburn  10908:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   10909:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  10910:     my $result='';
1.1056    raeburn  10911:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   10912:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   10913:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  10914:         return $result;
                   10915:     }
                   10916:     my $dirptr = 16384;
                   10917:     my ($newdirlistref,$newlisterror) =
                   10918:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   10919:     if (ref($newdirlistref) eq 'ARRAY') {
                   10920:         foreach my $dir_line (@{$newdirlistref}) {
                   10921:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   10922:             unless ($item =~ /^\.+$/) {
                   10923:                 $$count ++;
1.1056    raeburn  10924:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   10925:                 $titles->{$$count} = $item;
1.1055    raeburn  10926:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  10927: 
1.1055    raeburn  10928:                 my $is_dir;
                   10929:                 if ($dirptr&$testdir) {
                   10930:                     $is_dir = 1;
                   10931:                 }
                   10932:                 if ($wantform) {
                   10933:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   10934:                 }
                   10935:                 if ($is_dir) {
                   10936:                     $$depth ++;
1.1056    raeburn  10937:                     push(@{$hierarchy},$$count);
                   10938:                     $parent->{$$depth} = $$count;
1.1055    raeburn  10939:                     $result .=
                   10940:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   10941:                                                    $docuname,$depth,$count,
1.1056    raeburn  10942:                                                    $hierarchy,$dirorder,$children,
                   10943:                                                    $parent,$titles,$wantform);
1.1055    raeburn  10944:                     $$depth --;
1.1056    raeburn  10945:                     pop(@{$hierarchy});
1.1055    raeburn  10946:                 }
                   10947:             }
                   10948:         }
                   10949:     }
                   10950:     return $result;
                   10951: }
                   10952: 
                   10953: sub archive_hierarchy {
                   10954:     my ($depth,$count,$parent,$children) =@_;
                   10955:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   10956:         if (exists($parent->{$depth})) {
                   10957:              $children->{$parent->{$depth}} .= $count.':';
                   10958:         }
                   10959:     }
                   10960:     return;
                   10961: }
                   10962: 
                   10963: sub archive_row {
                   10964:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   10965:     my ($name) = ($item =~ m{([^/]+)$});
                   10966:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  10967:                                        'display'    => 'Add as file',
1.1055    raeburn  10968:                                        'dependency' => 'Include as dependency',
                   10969:                                        'discard'    => 'Discard',
                   10970:                                       );
                   10971:     if ($is_dir) {
1.1059    raeburn  10972:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  10973:     }
1.1056    raeburn  10974:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   10975:     my $offset = 0;
1.1055    raeburn  10976:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  10977:         $offset ++;
1.1065    raeburn  10978:         if ($action ne 'display') {
                   10979:             $offset ++;
                   10980:         }  
1.1055    raeburn  10981:         $output .= '<td><span class="LC_nobreak">'.
                   10982:                    '<label><input type="radio" name="archive_'.$count.
                   10983:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   10984:         my $text = $choices{$action};
                   10985:         if ($is_dir) {
                   10986:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   10987:             if ($action eq 'display') {
1.1059    raeburn  10988:                 $text = &mt('Add as folder');
1.1055    raeburn  10989:             }
1.1056    raeburn  10990:         } else {
                   10991:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   10992: 
                   10993:         }
                   10994:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   10995:         if ($action eq 'dependency') {
                   10996:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   10997:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   10998:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   10999:                        '<option value=""></option>'."\n".
                   11000:                        '</select>'."\n".
                   11001:                        '</div>';
1.1059    raeburn  11002:         } elsif ($action eq 'display') {
                   11003:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11004:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11005:                        '</div>';
1.1055    raeburn  11006:         }
1.1056    raeburn  11007:         $output .= '</td>';
1.1055    raeburn  11008:     }
                   11009:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11010:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11011:     for (my $i=0; $i<$depth; $i++) {
                   11012:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11013:     }
                   11014:     if ($is_dir) {
                   11015:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11016:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11017:     } else {
                   11018:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11019:     }
                   11020:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11021:                &end_data_table_row();
                   11022:     return $output;
                   11023: }
                   11024: 
                   11025: sub archive_options_form {
1.1065    raeburn  11026:     my ($form,$display,$count,$hiddenelem) = @_;
                   11027:     my %lt = &Apache::lonlocal::texthash(
                   11028:                perm => 'Permanently remove archive file?',
                   11029:                hows => 'How should each extracted item be incorporated in the course?',
                   11030:                cont => 'Content actions for all',
                   11031:                addf => 'Add as folder/file',
                   11032:                incd => 'Include as dependency for a displayed file',
                   11033:                disc => 'Discard',
                   11034:                no   => 'No',
                   11035:                yes  => 'Yes',
                   11036:                save => 'Save',
                   11037:     );
                   11038:     my $output = <<"END";
                   11039: <form name="$form" method="post" action="">
                   11040: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11041: <label>
                   11042:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11043: </label>
                   11044: &nbsp;
                   11045: <label>
                   11046:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11047: </span>
                   11048: </p>
                   11049: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11050: <br />$lt{'hows'}
                   11051: <div class="LC_columnSection">
                   11052:   <fieldset>
                   11053:     <legend>$lt{'cont'}</legend>
                   11054:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11055:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11056:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11057:   </fieldset>
                   11058: </div>
                   11059: END
                   11060:     return $output.
1.1055    raeburn  11061:            &start_data_table()."\n".
1.1065    raeburn  11062:            $display."\n".
1.1055    raeburn  11063:            &end_data_table()."\n".
                   11064:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11065:            $hiddenelem.
1.1065    raeburn  11066:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11067:            '</form>';
                   11068: }
                   11069: 
                   11070: sub archive_javascript {
1.1056    raeburn  11071:     my ($startcount,$numitems,$titles,$children) = @_;
                   11072:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11073:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11074:     my $scripttag = <<START;
                   11075: <script type="text/javascript">
                   11076: // <![CDATA[
                   11077: 
                   11078: function checkAll(form,prefix) {
                   11079:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11080:     for (var i=0; i < form.elements.length; i++) {
                   11081:         var id = form.elements[i].id;
                   11082:         if ((id != '') && (id != undefined)) {
                   11083:             if (idstr.test(id)) {
                   11084:                 if (form.elements[i].type == 'radio') {
                   11085:                     form.elements[i].checked = true;
1.1056    raeburn  11086:                     var nostart = i-$startcount;
1.1059    raeburn  11087:                     var offset = nostart%7;
                   11088:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11089:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11090:                 }
                   11091:             }
                   11092:         }
                   11093:     }
                   11094: }
                   11095: 
                   11096: function propagateCheck(form,count) {
                   11097:     if (count > 0) {
1.1059    raeburn  11098:         var startelement = $startcount + ((count-1) * 7);
                   11099:         for (var j=1; j<6; j++) {
                   11100:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11101:                 var item = startelement + j; 
                   11102:                 if (form.elements[item].type == 'radio') {
                   11103:                     if (form.elements[item].checked) {
                   11104:                         containerCheck(form,count,j);
                   11105:                         break;
                   11106:                     }
1.1055    raeburn  11107:                 }
                   11108:             }
                   11109:         }
                   11110:     }
                   11111: }
                   11112: 
                   11113: numitems = $numitems
1.1056    raeburn  11114: var titles = new Array(numitems);
                   11115: var parents = new Array(numitems);
1.1055    raeburn  11116: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11117:     parents[i] = new Array;
1.1055    raeburn  11118: }
1.1059    raeburn  11119: var maintitle = '$maintitle';
1.1055    raeburn  11120: 
                   11121: START
                   11122: 
1.1056    raeburn  11123:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11124:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11125:         for (my $i=0; $i<@contents; $i ++) {
                   11126:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11127:         }
                   11128:     }
                   11129: 
1.1056    raeburn  11130:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11131:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11132:     }
                   11133: 
1.1055    raeburn  11134:     $scripttag .= <<END;
                   11135: 
                   11136: function containerCheck(form,count,offset) {
                   11137:     if (count > 0) {
1.1056    raeburn  11138:         dependencyCheck(form,count,offset);
1.1059    raeburn  11139:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11140:         form.elements[item].checked = true;
                   11141:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11142:             if (parents[count].length > 0) {
                   11143:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11144:                     containerCheck(form,parents[count][j],offset);
                   11145:                 }
                   11146:             }
                   11147:         }
                   11148:     }
                   11149: }
                   11150: 
                   11151: function dependencyCheck(form,count,offset) {
                   11152:     if (count > 0) {
1.1059    raeburn  11153:         var chosen = (offset+$startcount)+7*(count-1);
                   11154:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11155:         var currtype = form.elements[depitem].type;
                   11156:         if (form.elements[chosen].value == 'dependency') {
                   11157:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11158:             form.elements[depitem].options.length = 0;
                   11159:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  11160:             for (var i=1; i<=numitems; i++) {
                   11161:                 if (i == count) {
                   11162:                     continue;
                   11163:                 }
1.1059    raeburn  11164:                 var startelement = $startcount + (i-1) * 7;
                   11165:                 for (var j=1; j<6; j++) {
                   11166:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11167:                         var item = startelement + j;
                   11168:                         if (form.elements[item].type == 'radio') {
                   11169:                             if (form.elements[item].checked) {
                   11170:                                 if (form.elements[item].value == 'display') {
                   11171:                                     var n = form.elements[depitem].options.length;
                   11172:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11173:                                 }
                   11174:                             }
                   11175:                         }
                   11176:                     }
                   11177:                 }
                   11178:             }
                   11179:         } else {
                   11180:             document.getElementById('arc_depon_'+count).style.display='none';
                   11181:             form.elements[depitem].options.length = 0;
                   11182:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11183:         }
1.1059    raeburn  11184:         titleCheck(form,count,offset);
1.1056    raeburn  11185:     }
                   11186: }
                   11187: 
                   11188: function propagateSelect(form,count,offset) {
                   11189:     if (count > 0) {
1.1065    raeburn  11190:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11191:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11192:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11193:             if (parents[count].length > 0) {
                   11194:                 for (var j=0; j<parents[count].length; j++) {
                   11195:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11196:                 }
                   11197:             }
                   11198:         }
                   11199:     }
                   11200: }
1.1056    raeburn  11201: 
                   11202: function containerSelect(form,count,offset,picked) {
                   11203:     if (count > 0) {
1.1065    raeburn  11204:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11205:         if (form.elements[item].type == 'radio') {
                   11206:             if (form.elements[item].value == 'dependency') {
                   11207:                 if (form.elements[item+1].type == 'select-one') {
                   11208:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11209:                         if (form.elements[item+1].options[i].value == picked) {
                   11210:                             form.elements[item+1].selectedIndex = i;
                   11211:                             break;
                   11212:                         }
                   11213:                     }
                   11214:                 }
                   11215:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11216:                     if (parents[count].length > 0) {
                   11217:                         for (var j=0; j<parents[count].length; j++) {
                   11218:                             containerSelect(form,parents[count][j],offset,picked);
                   11219:                         }
                   11220:                     }
                   11221:                 }
                   11222:             }
                   11223:         }
                   11224:     }
                   11225: }
                   11226: 
1.1059    raeburn  11227: function titleCheck(form,count,offset) {
                   11228:     if (count > 0) {
                   11229:         var chosen = (offset+$startcount)+7*(count-1);
                   11230:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11231:         var currtype = form.elements[depitem].type;
                   11232:         if (form.elements[chosen].value == 'display') {
                   11233:             document.getElementById('arc_title_'+count).style.display='block';
                   11234:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11235:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11236:             }
                   11237:         } else {
                   11238:             document.getElementById('arc_title_'+count).style.display='none';
                   11239:             if (currtype == 'text') { 
                   11240:                 document.getElementById('archive_title_'+count).value='';
                   11241:             }
                   11242:         }
                   11243:     }
                   11244:     return;
                   11245: }
                   11246: 
1.1055    raeburn  11247: // ]]>
                   11248: </script>
                   11249: END
                   11250:     return $scripttag;
                   11251: }
                   11252: 
                   11253: sub process_extracted_files {
1.1067    raeburn  11254:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11255:     my $numitems = $env{'form.archive_count'};
                   11256:     return unless ($numitems);
                   11257:     my @ids=&Apache::lonnet::current_machine_ids();
                   11258:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11259:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11260:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11261:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11262:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11263:         $pathtocheck = "$dir_root/$destination";
                   11264:         $dir = $dir_root;
                   11265:         $ishome = 1;
                   11266:     } else {
                   11267:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11268:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11269:         $dir = "$dir_root/$docudom/$docuname";    
                   11270:     }
                   11271:     my $currdir = "$dir_root/$destination";
                   11272:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11273:     if ($env{'form.folderpath'}) {
                   11274:         my @items = split('&',$env{'form.folderpath'});
                   11275:         $folders{'0'} = $items[-2];
                   11276:         $containers{'0'}='sequence';
                   11277:     } elsif ($env{'form.pagepath'}) {
                   11278:         my @items = split('&',$env{'form.pagepath'});
                   11279:         $folders{'0'} = $items[-2];
                   11280:         $containers{'0'}='page';
                   11281:     }
                   11282:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11283:     if ($numitems) {
                   11284:         for (my $i=1; $i<=$numitems; $i++) {
                   11285:             my $path = $env{'form.archive_content_'.$i};
                   11286:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11287:                 my $item = $1;
                   11288:                 $toplevelitems{$item} = $i;
                   11289:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11290:                     $is_dir{$item} = 1;
                   11291:                 }
                   11292:             }
                   11293:         }
                   11294:     }
1.1067    raeburn  11295:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11296:     if (keys(%toplevelitems) > 0) {
                   11297:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11298:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11299:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11300:     }
1.1066    raeburn  11301:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11302:     if ($numitems) {
                   11303:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  11304:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11305:             my $path = $env{'form.archive_content_'.$i};
                   11306:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11307:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11308:                     if ($prefix ne '' && $path ne '') {
                   11309:                         if (-e $prefix.$path) {
1.1066    raeburn  11310:                             if ((@archdirs > 0) && 
                   11311:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11312:                                 $todeletedir{$prefix.$path} = 1;
                   11313:                             } else {
                   11314:                                 $todelete{$prefix.$path} = 1;
                   11315:                             }
1.1055    raeburn  11316:                         }
                   11317:                     }
                   11318:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11319:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11320:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11321:                     $docstitle = $env{'form.archive_title_'.$i};
                   11322:                     if ($docstitle eq '') {
                   11323:                         $docstitle = $title;
                   11324:                     }
1.1055    raeburn  11325:                     $outer = 0;
1.1056    raeburn  11326:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11327:                         if (@{$dirorder{$i}} > 0) {
                   11328:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11329:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11330:                                     $outer = $item;
                   11331:                                     last;
                   11332:                                 }
                   11333:                             }
                   11334:                         }
                   11335:                     }
                   11336:                     my ($errtext,$fatal) = 
                   11337:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11338:                                                '/'.$folders{$outer}.'.'.
                   11339:                                                $containers{$outer});
                   11340:                     next if ($fatal);
                   11341:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11342:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11343:                             $mapinner{$i} = time;
1.1055    raeburn  11344:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11345:                             $containers{$i} = 'sequence';
                   11346:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11347:                                       $folders{$i}.'.'.$containers{$i};
                   11348:                             my $newidx = &LONCAPA::map::getresidx();
                   11349:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11350:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11351:                             push(@LONCAPA::map::order,$newidx);
                   11352:                             my ($outtext,$errtext) =
                   11353:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11354:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11355:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11356:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11357:                             unless ($errtext) {
                   11358:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11359:                             }
1.1055    raeburn  11360:                         }
                   11361:                     } else {
                   11362:                         if ($context eq 'coursedocs') {
                   11363:                             my $newidx=&LONCAPA::map::getresidx();
                   11364:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11365:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11366:                                       $title;
                   11367:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11368:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11369:                             }
                   11370:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11371:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11372:                             }
                   11373:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11374:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11375:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11376:                                 unless ($ishome) {
                   11377:                                     my $fetch = "$newdest{$i}/$title";
                   11378:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11379:                                     $prompttofetch{$fetch} = 1;
                   11380:                                 }
1.1055    raeburn  11381:                             }
                   11382:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11383:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11384:                             push(@LONCAPA::map::order, $newidx);
                   11385:                             my ($outtext,$errtext)=
                   11386:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11387:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11388:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11389:                             unless ($errtext) {
                   11390:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11391:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11392:                                 }
                   11393:                             }
1.1055    raeburn  11394:                         }
                   11395:                     }
1.1086    raeburn  11396:                 }
                   11397:             } else {
                   11398:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11399:             }
                   11400:         }
                   11401:         for (my $i=1; $i<=$numitems; $i++) {
                   11402:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11403:             my $path = $env{'form.archive_content_'.$i};
                   11404:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11405:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11406:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11407:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11408:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11409:                         my ($itemidx,$fullpath,$relpath);
                   11410:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11411:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11412:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  11413:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11414:                                     $itemidx = $j;
1.1056    raeburn  11415:                                 }
                   11416:                             }
1.1086    raeburn  11417:                         }
                   11418:                         if ($itemidx eq '') {
                   11419:                             $itemidx =  0;
                   11420:                         } 
                   11421:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11422:                             if ($mapinner{$referrer{$i}}) {
                   11423:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11424:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11425:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11426:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11427:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11428:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11429:                                             if (!-e $fullpath) {
                   11430:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11431:                                             }
                   11432:                                         }
1.1086    raeburn  11433:                                     } else {
                   11434:                                         last;
1.1056    raeburn  11435:                                     }
1.1086    raeburn  11436:                                 }
                   11437:                             }
                   11438:                         } elsif ($newdest{$referrer{$i}}) {
                   11439:                             $fullpath = $newdest{$referrer{$i}};
                   11440:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11441:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11442:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11443:                                     last;
                   11444:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11445:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11446:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11447:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11448:                                         if (!-e $fullpath) {
                   11449:                                             mkdir($fullpath,0755);
1.1056    raeburn  11450:                                         }
                   11451:                                     }
1.1086    raeburn  11452:                                 } else {
                   11453:                                     last;
1.1056    raeburn  11454:                                 }
1.1055    raeburn  11455:                             }
                   11456:                         }
1.1086    raeburn  11457:                         if ($fullpath ne '') {
                   11458:                             if (-e "$prefix$path") {
                   11459:                                 system("mv $prefix$path $fullpath/$title");
                   11460:                             }
                   11461:                             if (-e "$fullpath/$title") {
                   11462:                                 my $showpath;
                   11463:                                 if ($relpath ne '') {
                   11464:                                     $showpath = "$relpath/$title";
                   11465:                                 } else {
                   11466:                                     $showpath = "/$title";
                   11467:                                 } 
                   11468:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11469:                             } 
                   11470:                             unless ($ishome) {
                   11471:                                 my $fetch = "$fullpath/$title";
                   11472:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   11473:                                 $prompttofetch{$fetch} = 1;
                   11474:                             }
                   11475:                         }
1.1055    raeburn  11476:                     }
1.1086    raeburn  11477:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11478:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11479:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11480:                 }
                   11481:             } else {
                   11482:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11483:             }
                   11484:         }
                   11485:         if (keys(%todelete)) {
                   11486:             foreach my $key (keys(%todelete)) {
                   11487:                 unlink($key);
1.1066    raeburn  11488:             }
                   11489:         }
                   11490:         if (keys(%todeletedir)) {
                   11491:             foreach my $key (keys(%todeletedir)) {
                   11492:                 rmdir($key);
                   11493:             }
                   11494:         }
                   11495:         foreach my $dir (sort(keys(%is_dir))) {
                   11496:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11497:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11498:             }
                   11499:         }
1.1067    raeburn  11500:         if ($result ne '') {
                   11501:             $output .= '<ul>'."\n".
                   11502:                        $result."\n".
                   11503:                        '</ul>';
                   11504:         }
                   11505:         unless ($ishome) {
                   11506:             my $replicationfail;
                   11507:             foreach my $item (keys(%prompttofetch)) {
                   11508:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11509:                 unless ($fetchresult eq 'ok') {
                   11510:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11511:                 }
                   11512:             }
                   11513:             if ($replicationfail) {
                   11514:                 $output .= '<p class="LC_error">'.
                   11515:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   11516:                            $replicationfail.
                   11517:                            '</ul></p>';
                   11518:             }
                   11519:         }
1.1055    raeburn  11520:     } else {
                   11521:         $warning = &mt('No items found in archive.');
                   11522:     }
                   11523:     if ($error) {
                   11524:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11525:                    $error.'</p>'."\n";
                   11526:     }
                   11527:     if ($warning) {
                   11528:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11529:     }
                   11530:     return $output;
                   11531: }
                   11532: 
1.1066    raeburn  11533: sub cleanup_empty_dirs {
                   11534:     my ($path) = @_;
                   11535:     if (($path ne '') && (-d $path)) {
                   11536:         if (opendir(my $dirh,$path)) {
                   11537:             my @dircontents = grep(!/^\./,readdir($dirh));
                   11538:             my $numitems = 0;
                   11539:             foreach my $item (@dircontents) {
                   11540:                 if (-d "$path/$item") {
                   11541:                     &recurse_dirs("$path/$item");
                   11542:                     if (-e "$path/$item") {
                   11543:                         $numitems ++;
                   11544:                     }
                   11545:                 } else {
                   11546:                     $numitems ++;
                   11547:                 }
                   11548:             }
                   11549:             if ($numitems == 0) {
                   11550:                 rmdir($path);
                   11551:             }
                   11552:             closedir($dirh);
                   11553:         }
                   11554:     }
                   11555:     return;
                   11556: }
                   11557: 
1.41      ng       11558: =pod
1.45      matthew  11559: 
1.1068    raeburn  11560: =item &get_folder_hierarchy()
                   11561: 
                   11562: Provides hierarchy of names of folders/sub-folders containing the current
                   11563: item,
                   11564: 
                   11565: Inputs: 3
                   11566:      - $navmap - navmaps object
                   11567: 
                   11568:      - $map - url for map (either the trigger itself, or map containing
                   11569:                            the resource, which is the trigger).
                   11570: 
                   11571:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   11572: 
                   11573: Outputs: 1 @pathitems - array of folder/subfolder names.
                   11574: 
                   11575: =cut
                   11576: 
                   11577: sub get_folder_hierarchy {
                   11578:     my ($navmap,$map,$showitem) = @_;
                   11579:     my @pathitems;
                   11580:     if (ref($navmap)) {
                   11581:         my $mapres = $navmap->getResourceByUrl($map);
                   11582:         if (ref($mapres)) {
                   11583:             my $pcslist = $mapres->map_hierarchy();
                   11584:             if ($pcslist ne '') {
                   11585:                 my @pcs = split(/,/,$pcslist);
                   11586:                 foreach my $pc (@pcs) {
                   11587:                     if ($pc == 1) {
                   11588:                         push(@pathitems,&mt('Main Course Documents'));
                   11589:                     } else {
                   11590:                         my $res = $navmap->getByMapPc($pc);
                   11591:                         if (ref($res)) {
                   11592:                             my $title = $res->compTitle();
                   11593:                             $title =~ s/\W+/_/g;
                   11594:                             if ($title ne '') {
                   11595:                                 push(@pathitems,$title);
                   11596:                             }
                   11597:                         }
                   11598:                     }
                   11599:                 }
                   11600:             }
1.1071    raeburn  11601:             if ($showitem) {
                   11602:                 if ($mapres->{ID} eq '0.0') {
                   11603:                     push(@pathitems,&mt('Main Course Documents'));
                   11604:                 } else {
                   11605:                     my $maptitle = $mapres->compTitle();
                   11606:                     $maptitle =~ s/\W+/_/g;
                   11607:                     if ($maptitle ne '') {
                   11608:                         push(@pathitems,$maptitle);
                   11609:                     }
1.1068    raeburn  11610:                 }
                   11611:             }
                   11612:         }
                   11613:     }
                   11614:     return @pathitems;
                   11615: }
                   11616: 
                   11617: =pod
                   11618: 
1.1015    raeburn  11619: =item * &get_turnedin_filepath()
                   11620: 
                   11621: Determines path in a user's portfolio file for storage of files uploaded
                   11622: to a specific essayresponse or dropbox item.
                   11623: 
                   11624: Inputs: 3 required + 1 optional.
                   11625: $symb is symb for resource, $uname and $udom are for current user (required).
                   11626: $caller is optional (can be "submission", if routine is called when storing
                   11627: an upoaded file when "Submit Answer" button was pressed).
                   11628: 
                   11629: Returns array containing $path and $multiresp. 
                   11630: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   11631: than one file upload item.  Callers of routine should append partid as a 
                   11632: subdirectory to $path in cases where $multiresp is 1.
                   11633: 
                   11634: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   11635: 
                   11636: =cut
                   11637: 
                   11638: sub get_turnedin_filepath {
                   11639:     my ($symb,$uname,$udom,$caller) = @_;
                   11640:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   11641:     my $turnindir;
                   11642:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   11643:     $turnindir = $userhash{'turnindir'};
                   11644:     my ($path,$multiresp);
                   11645:     if ($turnindir eq '') {
                   11646:         if ($caller eq 'submission') {
                   11647:             $turnindir = &mt('turned in');
                   11648:             $turnindir =~ s/\W+/_/g;
                   11649:             my %newhash = (
                   11650:                             'turnindir' => $turnindir,
                   11651:                           );
                   11652:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   11653:         }
                   11654:     }
                   11655:     if ($turnindir ne '') {
                   11656:         $path = '/'.$turnindir.'/';
                   11657:         my ($multipart,$turnin,@pathitems);
                   11658:         my $navmap = Apache::lonnavmaps::navmap->new();
                   11659:         if (defined($navmap)) {
                   11660:             my $mapres = $navmap->getResourceByUrl($map);
                   11661:             if (ref($mapres)) {
                   11662:                 my $pcslist = $mapres->map_hierarchy();
                   11663:                 if ($pcslist ne '') {
                   11664:                     foreach my $pc (split(/,/,$pcslist)) {
                   11665:                         my $res = $navmap->getByMapPc($pc);
                   11666:                         if (ref($res)) {
                   11667:                             my $title = $res->compTitle();
                   11668:                             $title =~ s/\W+/_/g;
                   11669:                             if ($title ne '') {
                   11670:                                 push(@pathitems,$title);
                   11671:                             }
                   11672:                         }
                   11673:                     }
                   11674:                 }
                   11675:                 my $maptitle = $mapres->compTitle();
                   11676:                 $maptitle =~ s/\W+/_/g;
                   11677:                 if ($maptitle ne '') {
                   11678:                     push(@pathitems,$maptitle);
                   11679:                 }
                   11680:                 unless ($env{'request.state'} eq 'construct') {
                   11681:                     my $res = $navmap->getBySymb($symb);
                   11682:                     if (ref($res)) {
                   11683:                         my $partlist = $res->parts();
                   11684:                         my $totaluploads = 0;
                   11685:                         if (ref($partlist) eq 'ARRAY') {
                   11686:                             foreach my $part (@{$partlist}) {
                   11687:                                 my @types = $res->responseType($part);
                   11688:                                 my @ids = $res->responseIds($part);
                   11689:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   11690:                                     if ($types[$i] eq 'essay') {
                   11691:                                         my $partid = $part.'_'.$ids[$i];
                   11692:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   11693:                                             $totaluploads ++;
                   11694:                                         }
                   11695:                                     }
                   11696:                                 }
                   11697:                             }
                   11698:                             if ($totaluploads > 1) {
                   11699:                                 $multiresp = 1;
                   11700:                             }
                   11701:                         }
                   11702:                     }
                   11703:                 }
                   11704:             } else {
                   11705:                 return;
                   11706:             }
                   11707:         } else {
                   11708:             return;
                   11709:         }
                   11710:         my $restitle=&Apache::lonnet::gettitle($symb);
                   11711:         $restitle =~ s/\W+/_/g;
                   11712:         if ($restitle eq '') {
                   11713:             $restitle = ($resurl =~ m{/[^/]+$});
                   11714:             if ($restitle eq '') {
                   11715:                 $restitle = time;
                   11716:             }
                   11717:         }
                   11718:         push(@pathitems,$restitle);
                   11719:         $path .= join('/',@pathitems);
                   11720:     }
                   11721:     return ($path,$multiresp);
                   11722: }
                   11723: 
                   11724: =pod
                   11725: 
1.464     albertel 11726: =back
1.41      ng       11727: 
1.112     bowersj2 11728: =head1 CSV Upload/Handling functions
1.38      albertel 11729: 
1.41      ng       11730: =over 4
                   11731: 
1.648     raeburn  11732: =item * &upfile_store($r)
1.41      ng       11733: 
                   11734: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 11735: needs $env{'form.upfile'}
1.41      ng       11736: returns $datatoken to be put into hidden field
                   11737: 
                   11738: =cut
1.31      albertel 11739: 
                   11740: sub upfile_store {
                   11741:     my $r=shift;
1.258     albertel 11742:     $env{'form.upfile'}=~s/\r/\n/gs;
                   11743:     $env{'form.upfile'}=~s/\f/\n/gs;
                   11744:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   11745:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 11746: 
1.258     albertel 11747:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   11748: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 11749:     {
1.158     raeburn  11750:         my $datafile = $r->dir_config('lonDaemons').
                   11751:                            '/tmp/'.$datatoken.'.tmp';
                   11752:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 11753:             print $fh $env{'form.upfile'};
1.158     raeburn  11754:             close($fh);
                   11755:         }
1.31      albertel 11756:     }
                   11757:     return $datatoken;
                   11758: }
                   11759: 
1.56      matthew  11760: =pod
                   11761: 
1.648     raeburn  11762: =item * &load_tmp_file($r)
1.41      ng       11763: 
                   11764: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 11765: needs $env{'form.datatoken'},
                   11766: sets $env{'form.upfile'} to the contents of the file
1.41      ng       11767: 
                   11768: =cut
1.31      albertel 11769: 
                   11770: sub load_tmp_file {
                   11771:     my $r=shift;
                   11772:     my @studentdata=();
                   11773:     {
1.158     raeburn  11774:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 11775:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  11776:         if ( open(my $fh,"<$studentfile") ) {
                   11777:             @studentdata=<$fh>;
                   11778:             close($fh);
                   11779:         }
1.31      albertel 11780:     }
1.258     albertel 11781:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 11782: }
                   11783: 
1.56      matthew  11784: =pod
                   11785: 
1.648     raeburn  11786: =item * &upfile_record_sep()
1.41      ng       11787: 
                   11788: Separate uploaded file into records
                   11789: returns array of records,
1.258     albertel 11790: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       11791: 
                   11792: =cut
1.31      albertel 11793: 
                   11794: sub upfile_record_sep {
1.258     albertel 11795:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 11796:     } else {
1.248     albertel 11797: 	my @records;
1.258     albertel 11798: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 11799: 	    if ($line=~/^\s*$/) { next; }
                   11800: 	    push(@records,$line);
                   11801: 	}
                   11802: 	return @records;
1.31      albertel 11803:     }
                   11804: }
                   11805: 
1.56      matthew  11806: =pod
                   11807: 
1.648     raeburn  11808: =item * &record_sep($record)
1.41      ng       11809: 
1.258     albertel 11810: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       11811: 
                   11812: =cut
                   11813: 
1.263     www      11814: sub takeleft {
                   11815:     my $index=shift;
                   11816:     return substr('0000'.$index,-4,4);
                   11817: }
                   11818: 
1.31      albertel 11819: sub record_sep {
                   11820:     my $record=shift;
                   11821:     my %components=();
1.258     albertel 11822:     if ($env{'form.upfiletype'} eq 'xml') {
                   11823:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 11824:         my $i=0;
1.356     albertel 11825:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 11826:             $field=~s/^(\"|\')//;
                   11827:             $field=~s/(\"|\')$//;
1.263     www      11828:             $components{&takeleft($i)}=$field;
1.31      albertel 11829:             $i++;
                   11830:         }
1.258     albertel 11831:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 11832:         my $i=0;
1.356     albertel 11833:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 11834:             $field=~s/^(\"|\')//;
                   11835:             $field=~s/(\"|\')$//;
1.263     www      11836:             $components{&takeleft($i)}=$field;
1.31      albertel 11837:             $i++;
                   11838:         }
                   11839:     } else {
1.561     www      11840:         my $separator=',';
1.480     banghart 11841:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      11842:             $separator=';';
1.480     banghart 11843:         }
1.31      albertel 11844:         my $i=0;
1.561     www      11845: # the character we are looking for to indicate the end of a quote or a record 
                   11846:         my $looking_for=$separator;
                   11847: # do not add the characters to the fields
                   11848:         my $ignore=0;
                   11849: # we just encountered a separator (or the beginning of the record)
                   11850:         my $just_found_separator=1;
                   11851: # store the field we are working on here
                   11852:         my $field='';
                   11853: # work our way through all characters in record
                   11854:         foreach my $character ($record=~/(.)/g) {
                   11855:             if ($character eq $looking_for) {
                   11856:                if ($character ne $separator) {
                   11857: # Found the end of a quote, again looking for separator
                   11858:                   $looking_for=$separator;
                   11859:                   $ignore=1;
                   11860:                } else {
                   11861: # Found a separator, store away what we got
                   11862:                   $components{&takeleft($i)}=$field;
                   11863: 	          $i++;
                   11864:                   $just_found_separator=1;
                   11865:                   $ignore=0;
                   11866:                   $field='';
                   11867:                }
                   11868:                next;
                   11869:             }
                   11870: # single or double quotation marks after a separator indicate beginning of a quote
                   11871: # we are now looking for the end of the quote and need to ignore separators
                   11872:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   11873:                $looking_for=$character;
                   11874:                next;
                   11875:             }
                   11876: # ignore would be true after we reached the end of a quote
                   11877:             if ($ignore) { next; }
                   11878:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   11879:             $field.=$character;
                   11880:             $just_found_separator=0; 
1.31      albertel 11881:         }
1.561     www      11882: # catch the very last entry, since we never encountered the separator
                   11883:         $components{&takeleft($i)}=$field;
1.31      albertel 11884:     }
                   11885:     return %components;
                   11886: }
                   11887: 
1.144     matthew  11888: ######################################################
                   11889: ######################################################
                   11890: 
1.56      matthew  11891: =pod
                   11892: 
1.648     raeburn  11893: =item * &upfile_select_html()
1.41      ng       11894: 
1.144     matthew  11895: Return HTML code to select a file from the users machine and specify 
                   11896: the file type.
1.41      ng       11897: 
                   11898: =cut
                   11899: 
1.144     matthew  11900: ######################################################
                   11901: ######################################################
1.31      albertel 11902: sub upfile_select_html {
1.144     matthew  11903:     my %Types = (
                   11904:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 11905:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  11906:                  space => &mt('Space separated'),
                   11907:                  tab   => &mt('Tabulator separated'),
                   11908: #                 xml   => &mt('HTML/XML'),
                   11909:                  );
                   11910:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  11911:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  11912:     foreach my $type (sort(keys(%Types))) {
                   11913:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   11914:     }
                   11915:     $Str .= "</select>\n";
                   11916:     return $Str;
1.31      albertel 11917: }
                   11918: 
1.301     albertel 11919: sub get_samples {
                   11920:     my ($records,$toget) = @_;
                   11921:     my @samples=({});
                   11922:     my $got=0;
                   11923:     foreach my $rec (@$records) {
                   11924: 	my %temp = &record_sep($rec);
                   11925: 	if (! grep(/\S/, values(%temp))) { next; }
                   11926: 	if (%temp) {
                   11927: 	    $samples[$got]=\%temp;
                   11928: 	    $got++;
                   11929: 	    if ($got == $toget) { last; }
                   11930: 	}
                   11931:     }
                   11932:     return \@samples;
                   11933: }
                   11934: 
1.144     matthew  11935: ######################################################
                   11936: ######################################################
                   11937: 
1.56      matthew  11938: =pod
                   11939: 
1.648     raeburn  11940: =item * &csv_print_samples($r,$records)
1.41      ng       11941: 
                   11942: Prints a table of sample values from each column uploaded $r is an
                   11943: Apache Request ref, $records is an arrayref from
                   11944: &Apache::loncommon::upfile_record_sep
                   11945: 
                   11946: =cut
                   11947: 
1.144     matthew  11948: ######################################################
                   11949: ######################################################
1.31      albertel 11950: sub csv_print_samples {
                   11951:     my ($r,$records) = @_;
1.662     bisitz   11952:     my $samples = &get_samples($records,5);
1.301     albertel 11953: 
1.594     raeburn  11954:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   11955:               &start_data_table_header_row());
1.356     albertel 11956:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   11957:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  11958:     $r->print(&end_data_table_header_row());
1.301     albertel 11959:     foreach my $hash (@$samples) {
1.594     raeburn  11960: 	$r->print(&start_data_table_row());
1.356     albertel 11961: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 11962: 	    $r->print('<td>');
1.356     albertel 11963: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 11964: 	    $r->print('</td>');
                   11965: 	}
1.594     raeburn  11966: 	$r->print(&end_data_table_row());
1.31      albertel 11967:     }
1.594     raeburn  11968:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 11969: }
                   11970: 
1.144     matthew  11971: ######################################################
                   11972: ######################################################
                   11973: 
1.56      matthew  11974: =pod
                   11975: 
1.648     raeburn  11976: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       11977: 
                   11978: Prints a table to create associations between values and table columns.
1.144     matthew  11979: 
1.41      ng       11980: $r is an Apache Request ref,
                   11981: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  11982: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       11983: 
                   11984: =cut
                   11985: 
1.144     matthew  11986: ######################################################
                   11987: ######################################################
1.31      albertel 11988: sub csv_print_select_table {
                   11989:     my ($r,$records,$d) = @_;
1.301     albertel 11990:     my $i=0;
                   11991:     my $samples = &get_samples($records,1);
1.144     matthew  11992:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  11993: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  11994:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  11995:               '<th>'.&mt('Column').'</th>'.
                   11996:               &end_data_table_header_row()."\n");
1.356     albertel 11997:     foreach my $array_ref (@$d) {
                   11998: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  11999: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12000: 
1.875     bisitz   12001: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12002: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12003: 	$r->print('<option value="none"></option>');
1.356     albertel 12004: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12005: 	    $r->print('<option value="'.$sample.'"'.
                   12006:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12007:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12008: 	}
1.594     raeburn  12009: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12010: 	$i++;
                   12011:     }
1.594     raeburn  12012:     $r->print(&end_data_table());
1.31      albertel 12013:     $i--;
                   12014:     return $i;
                   12015: }
1.56      matthew  12016: 
1.144     matthew  12017: ######################################################
                   12018: ######################################################
                   12019: 
1.56      matthew  12020: =pod
1.31      albertel 12021: 
1.648     raeburn  12022: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12023: 
                   12024: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12025: 
                   12026: $r is an Apache Request ref,
                   12027: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12028: $d is an array of 2 element arrays (internal name, displayed name)
                   12029: 
                   12030: =cut
                   12031: 
1.144     matthew  12032: ######################################################
                   12033: ######################################################
1.31      albertel 12034: sub csv_samples_select_table {
                   12035:     my ($r,$records,$d) = @_;
                   12036:     my $i=0;
1.144     matthew  12037:     #
1.662     bisitz   12038:     my $max_samples = 5;
                   12039:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12040:     $r->print(&start_data_table().
                   12041:               &start_data_table_header_row().'<th>'.
                   12042:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12043:               &end_data_table_header_row());
1.301     albertel 12044: 
                   12045:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12046: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12047: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12048: 	foreach my $option (@$d) {
                   12049: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12050: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12051:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12052:                       $display.'</option>');
1.31      albertel 12053: 	}
                   12054: 	$r->print('</select></td><td>');
1.662     bisitz   12055: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12056: 	    if (defined($samples->[$line]{$key})) { 
                   12057: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12058: 	    }
                   12059: 	}
1.594     raeburn  12060: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12061: 	$i++;
                   12062:     }
1.594     raeburn  12063:     $r->print(&end_data_table());
1.31      albertel 12064:     $i--;
                   12065:     return($i);
1.115     matthew  12066: }
                   12067: 
1.144     matthew  12068: ######################################################
                   12069: ######################################################
                   12070: 
1.115     matthew  12071: =pod
                   12072: 
1.648     raeburn  12073: =item * &clean_excel_name($name)
1.115     matthew  12074: 
                   12075: Returns a replacement for $name which does not contain any illegal characters.
                   12076: 
                   12077: =cut
                   12078: 
1.144     matthew  12079: ######################################################
                   12080: ######################################################
1.115     matthew  12081: sub clean_excel_name {
                   12082:     my ($name) = @_;
                   12083:     $name =~ s/[:\*\?\/\\]//g;
                   12084:     if (length($name) > 31) {
                   12085:         $name = substr($name,0,31);
                   12086:     }
                   12087:     return $name;
1.25      albertel 12088: }
1.84      albertel 12089: 
1.85      albertel 12090: =pod
                   12091: 
1.648     raeburn  12092: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12093: 
                   12094: Returns either 1 or undef
                   12095: 
                   12096: 1 if the part is to be hidden, undef if it is to be shown
                   12097: 
                   12098: Arguments are:
                   12099: 
                   12100: $id the id of the part to be checked
                   12101: $symb, optional the symb of the resource to check
                   12102: $udom, optional the domain of the user to check for
                   12103: $uname, optional the username of the user to check for
                   12104: 
                   12105: =cut
1.84      albertel 12106: 
                   12107: sub check_if_partid_hidden {
                   12108:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12109:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12110: 					 $symb,$udom,$uname);
1.141     albertel 12111:     my $truth=1;
                   12112:     #if the string starts with !, then the list is the list to show not hide
                   12113:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12114:     my @hiddenlist=split(/,/,$hiddenparts);
                   12115:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12116: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12117:     }
1.141     albertel 12118:     return !$truth;
1.84      albertel 12119: }
1.127     matthew  12120: 
1.138     matthew  12121: 
                   12122: ############################################################
                   12123: ############################################################
                   12124: 
                   12125: =pod
                   12126: 
1.157     matthew  12127: =back 
                   12128: 
1.138     matthew  12129: =head1 cgi-bin script and graphing routines
                   12130: 
1.157     matthew  12131: =over 4
                   12132: 
1.648     raeburn  12133: =item * &get_cgi_id()
1.138     matthew  12134: 
                   12135: Inputs: none
                   12136: 
                   12137: Returns an id which can be used to pass environment variables
                   12138: to various cgi-bin scripts.  These environment variables will
                   12139: be removed from the users environment after a given time by
                   12140: the routine &Apache::lonnet::transfer_profile_to_env.
                   12141: 
                   12142: =cut
                   12143: 
                   12144: ############################################################
                   12145: ############################################################
1.152     albertel 12146: my $uniq=0;
1.136     matthew  12147: sub get_cgi_id {
1.154     albertel 12148:     $uniq=($uniq+1)%100000;
1.280     albertel 12149:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12150: }
                   12151: 
1.127     matthew  12152: ############################################################
                   12153: ############################################################
                   12154: 
                   12155: =pod
                   12156: 
1.648     raeburn  12157: =item * &DrawBarGraph()
1.127     matthew  12158: 
1.138     matthew  12159: Facilitates the plotting of data in a (stacked) bar graph.
                   12160: Puts plot definition data into the users environment in order for 
                   12161: graph.png to plot it.  Returns an <img> tag for the plot.
                   12162: The bars on the plot are labeled '1','2',...,'n'.
                   12163: 
                   12164: Inputs:
                   12165: 
                   12166: =over 4
                   12167: 
                   12168: =item $Title: string, the title of the plot
                   12169: 
                   12170: =item $xlabel: string, text describing the X-axis of the plot
                   12171: 
                   12172: =item $ylabel: string, text describing the Y-axis of the plot
                   12173: 
                   12174: =item $Max: scalar, the maximum Y value to use in the plot
                   12175: If $Max is < any data point, the graph will not be rendered.
                   12176: 
1.140     matthew  12177: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12178: they are plotted.  If undefined, default values will be used.
                   12179: 
1.178     matthew  12180: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12181: 
1.138     matthew  12182: =item @Values: An array of array references.  Each array reference holds data
                   12183: to be plotted in a stacked bar chart.
                   12184: 
1.239     matthew  12185: =item If the final element of @Values is a hash reference the key/value
                   12186: pairs will be added to the graph definition.
                   12187: 
1.138     matthew  12188: =back
                   12189: 
                   12190: Returns:
                   12191: 
                   12192: An <img> tag which references graph.png and the appropriate identifying
                   12193: information for the plot.
                   12194: 
1.127     matthew  12195: =cut
                   12196: 
                   12197: ############################################################
                   12198: ############################################################
1.134     matthew  12199: sub DrawBarGraph {
1.178     matthew  12200:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12201:     #
                   12202:     if (! defined($colors)) {
                   12203:         $colors = ['#33ff00', 
                   12204:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12205:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12206:                   ]; 
                   12207:     }
1.228     matthew  12208:     my $extra_settings = {};
                   12209:     if (ref($Values[-1]) eq 'HASH') {
                   12210:         $extra_settings = pop(@Values);
                   12211:     }
1.127     matthew  12212:     #
1.136     matthew  12213:     my $identifier = &get_cgi_id();
                   12214:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12215:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12216:         return '';
                   12217:     }
1.225     matthew  12218:     #
                   12219:     my @Labels;
                   12220:     if (defined($labels)) {
                   12221:         @Labels = @$labels;
                   12222:     } else {
                   12223:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12224:             push (@Labels,$i+1);
                   12225:         }
                   12226:     }
                   12227:     #
1.129     matthew  12228:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12229:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12230:     my %ValuesHash;
                   12231:     my $NumSets=1;
                   12232:     foreach my $array (@Values) {
                   12233:         next if (! ref($array));
1.136     matthew  12234:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12235:             join(',',@$array);
1.129     matthew  12236:     }
1.127     matthew  12237:     #
1.136     matthew  12238:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12239:     if ($NumBars < 3) {
                   12240:         $width = 120+$NumBars*32;
1.220     matthew  12241:         $xskip = 1;
1.225     matthew  12242:         $bar_width = 30;
                   12243:     } elsif ($NumBars < 5) {
                   12244:         $width = 120+$NumBars*20;
                   12245:         $xskip = 1;
                   12246:         $bar_width = 20;
1.220     matthew  12247:     } elsif ($NumBars < 10) {
1.136     matthew  12248:         $width = 120+$NumBars*15;
                   12249:         $xskip = 1;
                   12250:         $bar_width = 15;
                   12251:     } elsif ($NumBars <= 25) {
                   12252:         $width = 120+$NumBars*11;
                   12253:         $xskip = 5;
                   12254:         $bar_width = 8;
                   12255:     } elsif ($NumBars <= 50) {
                   12256:         $width = 120+$NumBars*8;
                   12257:         $xskip = 5;
                   12258:         $bar_width = 4;
                   12259:     } else {
                   12260:         $width = 120+$NumBars*8;
                   12261:         $xskip = 5;
                   12262:         $bar_width = 4;
                   12263:     }
                   12264:     #
1.137     matthew  12265:     $Max = 1 if ($Max < 1);
                   12266:     if ( int($Max) < $Max ) {
                   12267:         $Max++;
                   12268:         $Max = int($Max);
                   12269:     }
1.127     matthew  12270:     $Title  = '' if (! defined($Title));
                   12271:     $xlabel = '' if (! defined($xlabel));
                   12272:     $ylabel = '' if (! defined($ylabel));
1.369     www      12273:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12274:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12275:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12276:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12277:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12278:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12279:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12280:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12281:     $ValuesHash{$id.'.height'}   = $height;
                   12282:     $ValuesHash{$id.'.width'}    = $width;
                   12283:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12284:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12285:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12286:     #
1.228     matthew  12287:     # Deal with other parameters
                   12288:     while (my ($key,$value) = each(%$extra_settings)) {
                   12289:         $ValuesHash{$id.'.'.$key} = $value;
                   12290:     }
                   12291:     #
1.646     raeburn  12292:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12293:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12294: }
                   12295: 
                   12296: ############################################################
                   12297: ############################################################
                   12298: 
                   12299: =pod
                   12300: 
1.648     raeburn  12301: =item * &DrawXYGraph()
1.137     matthew  12302: 
1.138     matthew  12303: Facilitates the plotting of data in an XY graph.
                   12304: Puts plot definition data into the users environment in order for 
                   12305: graph.png to plot it.  Returns an <img> tag for the plot.
                   12306: 
                   12307: Inputs:
                   12308: 
                   12309: =over 4
                   12310: 
                   12311: =item $Title: string, the title of the plot
                   12312: 
                   12313: =item $xlabel: string, text describing the X-axis of the plot
                   12314: 
                   12315: =item $ylabel: string, text describing the Y-axis of the plot
                   12316: 
                   12317: =item $Max: scalar, the maximum Y value to use in the plot
                   12318: If $Max is < any data point, the graph will not be rendered.
                   12319: 
                   12320: =item $colors: Array ref containing the hex color codes for the data to be 
                   12321: plotted in.  If undefined, default values will be used.
                   12322: 
                   12323: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12324: 
                   12325: =item $Ydata: Array ref containing Array refs.  
1.185     www      12326: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12327: 
                   12328: =item %Values: hash indicating or overriding any default values which are 
                   12329: passed to graph.png.  
                   12330: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12331: 
                   12332: =back
                   12333: 
                   12334: Returns:
                   12335: 
                   12336: An <img> tag which references graph.png and the appropriate identifying
                   12337: information for the plot.
                   12338: 
1.137     matthew  12339: =cut
                   12340: 
                   12341: ############################################################
                   12342: ############################################################
                   12343: sub DrawXYGraph {
                   12344:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12345:     #
                   12346:     # Create the identifier for the graph
                   12347:     my $identifier = &get_cgi_id();
                   12348:     my $id = 'cgi.'.$identifier;
                   12349:     #
                   12350:     $Title  = '' if (! defined($Title));
                   12351:     $xlabel = '' if (! defined($xlabel));
                   12352:     $ylabel = '' if (! defined($ylabel));
                   12353:     my %ValuesHash = 
                   12354:         (
1.369     www      12355:          $id.'.title'  => &escape($Title),
                   12356:          $id.'.xlabel' => &escape($xlabel),
                   12357:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12358:          $id.'.y_max_value'=> $Max,
                   12359:          $id.'.labels'     => join(',',@$Xlabels),
                   12360:          $id.'.PlotType'   => 'XY',
                   12361:          );
                   12362:     #
                   12363:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12364:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12365:     }
                   12366:     #
                   12367:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12368:         return '';
                   12369:     }
                   12370:     my $NumSets=1;
1.138     matthew  12371:     foreach my $array (@{$Ydata}){
1.137     matthew  12372:         next if (! ref($array));
                   12373:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12374:     }
1.138     matthew  12375:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12376:     #
                   12377:     # Deal with other parameters
                   12378:     while (my ($key,$value) = each(%Values)) {
                   12379:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12380:     }
                   12381:     #
1.646     raeburn  12382:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12383:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12384: }
                   12385: 
                   12386: ############################################################
                   12387: ############################################################
                   12388: 
                   12389: =pod
                   12390: 
1.648     raeburn  12391: =item * &DrawXYYGraph()
1.138     matthew  12392: 
                   12393: Facilitates the plotting of data in an XY graph with two Y axes.
                   12394: Puts plot definition data into the users environment in order for 
                   12395: graph.png to plot it.  Returns an <img> tag for the plot.
                   12396: 
                   12397: Inputs:
                   12398: 
                   12399: =over 4
                   12400: 
                   12401: =item $Title: string, the title of the plot
                   12402: 
                   12403: =item $xlabel: string, text describing the X-axis of the plot
                   12404: 
                   12405: =item $ylabel: string, text describing the Y-axis of the plot
                   12406: 
                   12407: =item $colors: Array ref containing the hex color codes for the data to be 
                   12408: plotted in.  If undefined, default values will be used.
                   12409: 
                   12410: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12411: 
                   12412: =item $Ydata1: The first data set
                   12413: 
                   12414: =item $Min1: The minimum value of the left Y-axis
                   12415: 
                   12416: =item $Max1: The maximum value of the left Y-axis
                   12417: 
                   12418: =item $Ydata2: The second data set
                   12419: 
                   12420: =item $Min2: The minimum value of the right Y-axis
                   12421: 
                   12422: =item $Max2: The maximum value of the left Y-axis
                   12423: 
                   12424: =item %Values: hash indicating or overriding any default values which are 
                   12425: passed to graph.png.  
                   12426: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12427: 
                   12428: =back
                   12429: 
                   12430: Returns:
                   12431: 
                   12432: An <img> tag which references graph.png and the appropriate identifying
                   12433: information for the plot.
1.136     matthew  12434: 
                   12435: =cut
                   12436: 
                   12437: ############################################################
                   12438: ############################################################
1.137     matthew  12439: sub DrawXYYGraph {
                   12440:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12441:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12442:     #
                   12443:     # Create the identifier for the graph
                   12444:     my $identifier = &get_cgi_id();
                   12445:     my $id = 'cgi.'.$identifier;
                   12446:     #
                   12447:     $Title  = '' if (! defined($Title));
                   12448:     $xlabel = '' if (! defined($xlabel));
                   12449:     $ylabel = '' if (! defined($ylabel));
                   12450:     my %ValuesHash = 
                   12451:         (
1.369     www      12452:          $id.'.title'  => &escape($Title),
                   12453:          $id.'.xlabel' => &escape($xlabel),
                   12454:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12455:          $id.'.labels' => join(',',@$Xlabels),
                   12456:          $id.'.PlotType' => 'XY',
                   12457:          $id.'.NumSets' => 2,
1.137     matthew  12458:          $id.'.two_axes' => 1,
                   12459:          $id.'.y1_max_value' => $Max1,
                   12460:          $id.'.y1_min_value' => $Min1,
                   12461:          $id.'.y2_max_value' => $Max2,
                   12462:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12463:          );
                   12464:     #
1.137     matthew  12465:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12466:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12467:     }
                   12468:     #
                   12469:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12470:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12471:         return '';
                   12472:     }
                   12473:     my $NumSets=1;
1.137     matthew  12474:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12475:         next if (! ref($array));
                   12476:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12477:     }
                   12478:     #
                   12479:     # Deal with other parameters
                   12480:     while (my ($key,$value) = each(%Values)) {
                   12481:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12482:     }
                   12483:     #
1.646     raeburn  12484:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12485:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12486: }
                   12487: 
                   12488: ############################################################
                   12489: ############################################################
                   12490: 
                   12491: =pod
                   12492: 
1.157     matthew  12493: =back 
                   12494: 
1.139     matthew  12495: =head1 Statistics helper routines?  
                   12496: 
                   12497: Bad place for them but what the hell.
                   12498: 
1.157     matthew  12499: =over 4
                   12500: 
1.648     raeburn  12501: =item * &chartlink()
1.139     matthew  12502: 
                   12503: Returns a link to the chart for a specific student.  
                   12504: 
                   12505: Inputs:
                   12506: 
                   12507: =over 4
                   12508: 
                   12509: =item $linktext: The text of the link
                   12510: 
                   12511: =item $sname: The students username
                   12512: 
                   12513: =item $sdomain: The students domain
                   12514: 
                   12515: =back
                   12516: 
1.157     matthew  12517: =back
                   12518: 
1.139     matthew  12519: =cut
                   12520: 
                   12521: ############################################################
                   12522: ############################################################
                   12523: sub chartlink {
                   12524:     my ($linktext, $sname, $sdomain) = @_;
                   12525:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      12526:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 12527:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  12528:        '">'.$linktext.'</a>';
1.153     matthew  12529: }
                   12530: 
                   12531: #######################################################
                   12532: #######################################################
                   12533: 
                   12534: =pod
                   12535: 
                   12536: =head1 Course Environment Routines
1.157     matthew  12537: 
                   12538: =over 4
1.153     matthew  12539: 
1.648     raeburn  12540: =item * &restore_course_settings()
1.153     matthew  12541: 
1.648     raeburn  12542: =item * &store_course_settings()
1.153     matthew  12543: 
                   12544: Restores/Store indicated form parameters from the course environment.
                   12545: Will not overwrite existing values of the form parameters.
                   12546: 
                   12547: Inputs: 
                   12548: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   12549: 
                   12550: a hash ref describing the data to be stored.  For example:
                   12551:    
                   12552: %Save_Parameters = ('Status' => 'scalar',
                   12553:     'chartoutputmode' => 'scalar',
                   12554:     'chartoutputdata' => 'scalar',
                   12555:     'Section' => 'array',
1.373     raeburn  12556:     'Group' => 'array',
1.153     matthew  12557:     'StudentData' => 'array',
                   12558:     'Maps' => 'array');
                   12559: 
                   12560: Returns: both routines return nothing
                   12561: 
1.631     raeburn  12562: =back
                   12563: 
1.153     matthew  12564: =cut
                   12565: 
                   12566: #######################################################
                   12567: #######################################################
                   12568: sub store_course_settings {
1.496     albertel 12569:     return &store_settings($env{'request.course.id'},@_);
                   12570: }
                   12571: 
                   12572: sub store_settings {
1.153     matthew  12573:     # save to the environment
                   12574:     # appenv the same items, just to be safe
1.300     albertel 12575:     my $udom  = $env{'user.domain'};
                   12576:     my $uname = $env{'user.name'};
1.496     albertel 12577:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12578:     my %SaveHash;
                   12579:     my %AppHash;
                   12580:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 12581:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 12582:         my $envname = 'environment.'.$basename;
1.258     albertel 12583:         if (exists($env{'form.'.$setting})) {
1.153     matthew  12584:             # Save this value away
                   12585:             if ($type eq 'scalar' &&
1.258     albertel 12586:                 (! exists($env{$envname}) || 
                   12587:                  $env{$envname} ne $env{'form.'.$setting})) {
                   12588:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   12589:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  12590:             } elsif ($type eq 'array') {
                   12591:                 my $stored_form;
1.258     albertel 12592:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  12593:                     $stored_form = join(',',
                   12594:                                         map {
1.369     www      12595:                                             &escape($_);
1.258     albertel 12596:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  12597:                 } else {
                   12598:                     $stored_form = 
1.369     www      12599:                         &escape($env{'form.'.$setting});
1.153     matthew  12600:                 }
                   12601:                 # Determine if the array contents are the same.
1.258     albertel 12602:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  12603:                     $SaveHash{$basename} = $stored_form;
                   12604:                     $AppHash{$envname}   = $stored_form;
                   12605:                 }
                   12606:             }
                   12607:         }
                   12608:     }
                   12609:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 12610:                                           $udom,$uname);
1.153     matthew  12611:     if ($put_result !~ /^(ok|delayed)/) {
                   12612:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   12613:                                  'got error:'.$put_result);
                   12614:     }
                   12615:     # Make sure these settings stick around in this session, too
1.646     raeburn  12616:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  12617:     return;
                   12618: }
                   12619: 
                   12620: sub restore_course_settings {
1.499     albertel 12621:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 12622: }
                   12623: 
                   12624: sub restore_settings {
                   12625:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12626:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 12627:         next if (exists($env{'form.'.$setting}));
1.496     albertel 12628:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  12629:             '.'.$setting;
1.258     albertel 12630:         if (exists($env{$envname})) {
1.153     matthew  12631:             if ($type eq 'scalar') {
1.258     albertel 12632:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  12633:             } elsif ($type eq 'array') {
1.258     albertel 12634:                 $env{'form.'.$setting} = [ 
1.153     matthew  12635:                                            map { 
1.369     www      12636:                                                &unescape($_); 
1.258     albertel 12637:                                            } split(',',$env{$envname})
1.153     matthew  12638:                                            ];
                   12639:             }
                   12640:         }
                   12641:     }
1.127     matthew  12642: }
                   12643: 
1.618     raeburn  12644: #######################################################
                   12645: #######################################################
                   12646: 
                   12647: =pod
                   12648: 
                   12649: =head1 Domain E-mail Routines  
                   12650: 
                   12651: =over 4
                   12652: 
1.648     raeburn  12653: =item * &build_recipient_list()
1.618     raeburn  12654: 
1.884     raeburn  12655: Build recipient lists for five types of e-mail:
1.766     raeburn  12656: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  12657: (d) Help requests, (e) Course requests needing approval,  generated by
                   12658: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   12659: loncoursequeueadmin.pm respectively.
1.618     raeburn  12660: 
                   12661: Inputs:
1.619     raeburn  12662: defmail (scalar - email address of default recipient), 
1.618     raeburn  12663: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  12664: defdom (domain for which to retrieve configuration settings),
                   12665: origmail (scalar - email address of recipient from loncapa.conf, 
                   12666: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  12667: 
1.655     raeburn  12668: Returns: comma separated list of addresses to which to send e-mail.
                   12669: 
                   12670: =back
1.618     raeburn  12671: 
                   12672: =cut
                   12673: 
                   12674: ############################################################
                   12675: ############################################################
                   12676: sub build_recipient_list {
1.619     raeburn  12677:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  12678:     my @recipients;
                   12679:     my $otheremails;
                   12680:     my %domconfig =
                   12681:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   12682:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  12683:         if (exists($domconfig{'contacts'}{$mailing})) {
                   12684:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   12685:                 my @contacts = ('adminemail','supportemail');
                   12686:                 foreach my $item (@contacts) {
                   12687:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   12688:                         my $addr = $domconfig{'contacts'}{$item}; 
                   12689:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12690:                             push(@recipients,$addr);
                   12691:                         }
1.619     raeburn  12692:                     }
1.766     raeburn  12693:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  12694:                 }
                   12695:             }
1.766     raeburn  12696:         } elsif ($origmail ne '') {
                   12697:             push(@recipients,$origmail);
1.618     raeburn  12698:         }
1.619     raeburn  12699:     } elsif ($origmail ne '') {
                   12700:         push(@recipients,$origmail);
1.618     raeburn  12701:     }
1.688     raeburn  12702:     if (defined($defmail)) {
                   12703:         if ($defmail ne '') {
                   12704:             push(@recipients,$defmail);
                   12705:         }
1.618     raeburn  12706:     }
                   12707:     if ($otheremails) {
1.619     raeburn  12708:         my @others;
                   12709:         if ($otheremails =~ /,/) {
                   12710:             @others = split(/,/,$otheremails);
1.618     raeburn  12711:         } else {
1.619     raeburn  12712:             push(@others,$otheremails);
                   12713:         }
                   12714:         foreach my $addr (@others) {
                   12715:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12716:                 push(@recipients,$addr);
                   12717:             }
1.618     raeburn  12718:         }
                   12719:     }
1.619     raeburn  12720:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  12721:     return $recipientlist;
                   12722: }
                   12723: 
1.127     matthew  12724: ############################################################
                   12725: ############################################################
1.154     albertel 12726: 
1.655     raeburn  12727: =pod
                   12728: 
                   12729: =head1 Course Catalog Routines
                   12730: 
                   12731: =over 4
                   12732: 
                   12733: =item * &gather_categories()
                   12734: 
                   12735: Converts category definitions - keys of categories hash stored in  
                   12736: coursecategories in configuration.db on the primary library server in a 
                   12737: domain - to an array.  Also generates javascript and idx hash used to 
                   12738: generate Domain Coordinator interface for editing Course Categories.
                   12739: 
                   12740: Inputs:
1.663     raeburn  12741: 
1.655     raeburn  12742: categories (reference to hash of category definitions).
1.663     raeburn  12743: 
1.655     raeburn  12744: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12745:       categories and subcategories).
1.663     raeburn  12746: 
1.655     raeburn  12747: idx (reference to hash of counters used in Domain Coordinator interface for 
                   12748:       editing Course Categories).
1.663     raeburn  12749: 
1.655     raeburn  12750: jsarray (reference to array of categories used to create Javascript arrays for
                   12751:          Domain Coordinator interface for editing Course Categories).
                   12752: 
                   12753: Returns: nothing
                   12754: 
                   12755: Side effects: populates cats, idx and jsarray. 
                   12756: 
                   12757: =cut
                   12758: 
                   12759: sub gather_categories {
                   12760:     my ($categories,$cats,$idx,$jsarray) = @_;
                   12761:     my %counters;
                   12762:     my $num = 0;
                   12763:     foreach my $item (keys(%{$categories})) {
                   12764:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   12765:         if ($container eq '' && $depth == 0) {
                   12766:             $cats->[$depth][$categories->{$item}] = $cat;
                   12767:         } else {
                   12768:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   12769:         }
                   12770:         my ($escitem,$tail) = split(/:/,$item,2);
                   12771:         if ($counters{$tail} eq '') {
                   12772:             $counters{$tail} = $num;
                   12773:             $num ++;
                   12774:         }
                   12775:         if (ref($idx) eq 'HASH') {
                   12776:             $idx->{$item} = $counters{$tail};
                   12777:         }
                   12778:         if (ref($jsarray) eq 'ARRAY') {
                   12779:             push(@{$jsarray->[$counters{$tail}]},$item);
                   12780:         }
                   12781:     }
                   12782:     return;
                   12783: }
                   12784: 
                   12785: =pod
                   12786: 
                   12787: =item * &extract_categories()
                   12788: 
                   12789: Used to generate breadcrumb trails for course categories.
                   12790: 
                   12791: Inputs:
1.663     raeburn  12792: 
1.655     raeburn  12793: categories (reference to hash of category definitions).
1.663     raeburn  12794: 
1.655     raeburn  12795: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12796:       categories and subcategories).
1.663     raeburn  12797: 
1.655     raeburn  12798: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  12799: 
1.655     raeburn  12800: allitems (reference to hash - key is category key 
                   12801:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12802: 
1.655     raeburn  12803: idx (reference to hash of counters used in Domain Coordinator interface for
                   12804:       editing Course Categories).
1.663     raeburn  12805: 
1.655     raeburn  12806: jsarray (reference to array of categories used to create Javascript arrays for
                   12807:          Domain Coordinator interface for editing Course Categories).
                   12808: 
1.665     raeburn  12809: subcats (reference to hash of arrays containing all subcategories within each 
                   12810:          category, -recursive)
                   12811: 
1.655     raeburn  12812: Returns: nothing
                   12813: 
                   12814: Side effects: populates trails and allitems hash references.
                   12815: 
                   12816: =cut
                   12817: 
                   12818: sub extract_categories {
1.665     raeburn  12819:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  12820:     if (ref($categories) eq 'HASH') {
                   12821:         &gather_categories($categories,$cats,$idx,$jsarray);
                   12822:         if (ref($cats->[0]) eq 'ARRAY') {
                   12823:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   12824:                 my $name = $cats->[0][$i];
                   12825:                 my $item = &escape($name).'::0';
                   12826:                 my $trailstr;
                   12827:                 if ($name eq 'instcode') {
                   12828:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  12829:                 } elsif ($name eq 'communities') {
                   12830:                     $trailstr = &mt('Communities');
1.655     raeburn  12831:                 } else {
                   12832:                     $trailstr = $name;
                   12833:                 }
                   12834:                 if ($allitems->{$item} eq '') {
                   12835:                     push(@{$trails},$trailstr);
                   12836:                     $allitems->{$item} = scalar(@{$trails})-1;
                   12837:                 }
                   12838:                 my @parents = ($name);
                   12839:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   12840:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   12841:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  12842:                         if (ref($subcats) eq 'HASH') {
                   12843:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   12844:                         }
                   12845:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   12846:                     }
                   12847:                 } else {
                   12848:                     if (ref($subcats) eq 'HASH') {
                   12849:                         $subcats->{$item} = [];
1.655     raeburn  12850:                     }
                   12851:                 }
                   12852:             }
                   12853:         }
                   12854:     }
                   12855:     return;
                   12856: }
                   12857: 
                   12858: =pod
                   12859: 
                   12860: =item *&recurse_categories()
                   12861: 
                   12862: Recursively used to generate breadcrumb trails for course categories.
                   12863: 
                   12864: Inputs:
1.663     raeburn  12865: 
1.655     raeburn  12866: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12867:       categories and subcategories).
1.663     raeburn  12868: 
1.655     raeburn  12869: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  12870: 
                   12871: category (current course category, for which breadcrumb trail is being generated).
                   12872: 
                   12873: trails (reference to array of breadcrumb trails for each category).
                   12874: 
1.655     raeburn  12875: allitems (reference to hash - key is category key
                   12876:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12877: 
1.655     raeburn  12878: parents (array containing containers directories for current category, 
                   12879:          back to top level). 
                   12880: 
                   12881: Returns: nothing
                   12882: 
                   12883: Side effects: populates trails and allitems hash references
                   12884: 
                   12885: =cut
                   12886: 
                   12887: sub recurse_categories {
1.665     raeburn  12888:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  12889:     my $shallower = $depth - 1;
                   12890:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   12891:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   12892:             my $name = $cats->[$depth]{$category}[$k];
                   12893:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12894:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12895:             if ($allitems->{$item} eq '') {
                   12896:                 push(@{$trails},$trailstr);
                   12897:                 $allitems->{$item} = scalar(@{$trails})-1;
                   12898:             }
                   12899:             my $deeper = $depth+1;
                   12900:             push(@{$parents},$category);
1.665     raeburn  12901:             if (ref($subcats) eq 'HASH') {
                   12902:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   12903:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   12904:                     my $higher;
                   12905:                     if ($j > 0) {
                   12906:                         $higher = &escape($parents->[$j]).':'.
                   12907:                                   &escape($parents->[$j-1]).':'.$j;
                   12908:                     } else {
                   12909:                         $higher = &escape($parents->[$j]).'::'.$j;
                   12910:                     }
                   12911:                     push(@{$subcats->{$higher}},$subcat);
                   12912:                 }
                   12913:             }
                   12914:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   12915:                                 $subcats);
1.655     raeburn  12916:             pop(@{$parents});
                   12917:         }
                   12918:     } else {
                   12919:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12920:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12921:         if ($allitems->{$item} eq '') {
                   12922:             push(@{$trails},$trailstr);
                   12923:             $allitems->{$item} = scalar(@{$trails})-1;
                   12924:         }
                   12925:     }
                   12926:     return;
                   12927: }
                   12928: 
1.663     raeburn  12929: =pod
                   12930: 
                   12931: =item *&assign_categories_table()
                   12932: 
                   12933: Create a datatable for display of hierarchical categories in a domain,
                   12934: with checkboxes to allow a course to be categorized. 
                   12935: 
                   12936: Inputs:
                   12937: 
                   12938: cathash - reference to hash of categories defined for the domain (from
                   12939:           configuration.db)
                   12940: 
                   12941: currcat - scalar with an & separated list of categories assigned to a course. 
                   12942: 
1.919     raeburn  12943: type    - scalar contains course type (Course or Community).
                   12944: 
1.663     raeburn  12945: Returns: $output (markup to be displayed) 
                   12946: 
                   12947: =cut
                   12948: 
                   12949: sub assign_categories_table {
1.919     raeburn  12950:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  12951:     my $output;
                   12952:     if (ref($cathash) eq 'HASH') {
                   12953:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   12954:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   12955:         $maxdepth = scalar(@cats);
                   12956:         if (@cats > 0) {
                   12957:             my $itemcount = 0;
                   12958:             if (ref($cats[0]) eq 'ARRAY') {
                   12959:                 my @currcategories;
                   12960:                 if ($currcat ne '') {
                   12961:                     @currcategories = split('&',$currcat);
                   12962:                 }
1.919     raeburn  12963:                 my $table;
1.663     raeburn  12964:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   12965:                     my $parent = $cats[0][$i];
1.919     raeburn  12966:                     next if ($parent eq 'instcode');
                   12967:                     if ($type eq 'Community') {
                   12968:                         next unless ($parent eq 'communities');
                   12969:                     } else {
                   12970:                         next if ($parent eq 'communities');
                   12971:                     }
1.663     raeburn  12972:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   12973:                     my $item = &escape($parent).'::0';
                   12974:                     my $checked = '';
                   12975:                     if (@currcategories > 0) {
                   12976:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   12977:                             $checked = ' checked="checked"';
1.663     raeburn  12978:                         }
                   12979:                     }
1.919     raeburn  12980:                     my $parent_title = $parent;
                   12981:                     if ($parent eq 'communities') {
                   12982:                         $parent_title = &mt('Communities');
                   12983:                     }
                   12984:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   12985:                               '<input type="checkbox" name="usecategory" value="'.
                   12986:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   12987:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  12988:                     my $depth = 1;
                   12989:                     push(@path,$parent);
1.919     raeburn  12990:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  12991:                     pop(@path);
1.919     raeburn  12992:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  12993:                     $itemcount ++;
                   12994:                 }
1.919     raeburn  12995:                 if ($itemcount) {
                   12996:                     $output = &Apache::loncommon::start_data_table().
                   12997:                               $table.
                   12998:                               &Apache::loncommon::end_data_table();
                   12999:                 }
1.663     raeburn  13000:             }
                   13001:         }
                   13002:     }
                   13003:     return $output;
                   13004: }
                   13005: 
                   13006: =pod
                   13007: 
                   13008: =item *&assign_category_rows()
                   13009: 
                   13010: Create a datatable row for display of nested categories in a domain,
                   13011: with checkboxes to allow a course to be categorized,called recursively.
                   13012: 
                   13013: Inputs:
                   13014: 
                   13015: itemcount - track row number for alternating colors
                   13016: 
                   13017: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13018:       categories and subcategories.
                   13019: 
                   13020: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13021: 
                   13022: parent - parent of current category item
                   13023: 
                   13024: path - Array containing all categories back up through the hierarchy from the
                   13025:        current category to the top level.
                   13026: 
                   13027: currcategories - reference to array of current categories assigned to the course
                   13028: 
                   13029: Returns: $output (markup to be displayed).
                   13030: 
                   13031: =cut
                   13032: 
                   13033: sub assign_category_rows {
                   13034:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13035:     my ($text,$name,$item,$chgstr);
                   13036:     if (ref($cats) eq 'ARRAY') {
                   13037:         my $maxdepth = scalar(@{$cats});
                   13038:         if (ref($cats->[$depth]) eq 'HASH') {
                   13039:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13040:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13041:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13042:                 $text .= '<td><table class="LC_datatable">';
                   13043:                 for (my $j=0; $j<$numchildren; $j++) {
                   13044:                     $name = $cats->[$depth]{$parent}[$j];
                   13045:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13046:                     my $deeper = $depth+1;
                   13047:                     my $checked = '';
                   13048:                     if (ref($currcategories) eq 'ARRAY') {
                   13049:                         if (@{$currcategories} > 0) {
                   13050:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13051:                                 $checked = ' checked="checked"';
1.663     raeburn  13052:                             }
                   13053:                         }
                   13054:                     }
1.664     raeburn  13055:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13056:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13057:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13058:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13059:                              '</td><td>';
1.663     raeburn  13060:                     if (ref($path) eq 'ARRAY') {
                   13061:                         push(@{$path},$name);
                   13062:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13063:                         pop(@{$path});
                   13064:                     }
                   13065:                     $text .= '</td></tr>';
                   13066:                 }
                   13067:                 $text .= '</table></td>';
                   13068:             }
                   13069:         }
                   13070:     }
                   13071:     return $text;
                   13072: }
                   13073: 
1.655     raeburn  13074: ############################################################
                   13075: ############################################################
                   13076: 
                   13077: 
1.443     albertel 13078: sub commit_customrole {
1.664     raeburn  13079:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13080:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13081:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13082:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13083:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13084:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13085:                  '</b><br />';
                   13086:     return $output;
                   13087: }
                   13088: 
                   13089: sub commit_standardrole {
1.541     raeburn  13090:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   13091:     my ($output,$logmsg,$linefeed);
                   13092:     if ($context eq 'auto') {
                   13093:         $linefeed = "\n";
                   13094:     } else {
                   13095:         $linefeed = "<br />\n";
                   13096:     }  
1.443     albertel 13097:     if ($three eq 'st') {
1.541     raeburn  13098:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   13099:                                          $one,$two,$sec,$context);
                   13100:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13101:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13102:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13103:         } else {
1.541     raeburn  13104:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13105:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13106:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13107:             if ($context eq 'auto') {
                   13108:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13109:             } else {
                   13110:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13111:                &mt('Add to classlist').': <b>ok</b>';
                   13112:             }
                   13113:             $output .= $linefeed;
1.443     albertel 13114:         }
                   13115:     } else {
                   13116:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13117:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13118:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13119:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13120:         if ($context eq 'auto') {
                   13121:             $output .= $result.$linefeed;
                   13122:         } else {
                   13123:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13124:         }
1.443     albertel 13125:     }
                   13126:     return $output;
                   13127: }
                   13128: 
                   13129: sub commit_studentrole {
1.541     raeburn  13130:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  13131:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13132:     if ($context eq 'auto') {
                   13133:         $linefeed = "\n";
                   13134:     } else {
                   13135:         $linefeed = '<br />'."\n";
                   13136:     }
1.443     albertel 13137:     if (defined($one) && defined($two)) {
                   13138:         my $cid=$one.'_'.$two;
                   13139:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13140:         my $secchange = 0;
                   13141:         my $expire_role_result;
                   13142:         my $modify_section_result;
1.628     raeburn  13143:         if ($oldsec ne '-1') { 
                   13144:             if ($oldsec ne $sec) {
1.443     albertel 13145:                 $secchange = 1;
1.628     raeburn  13146:                 my $now = time;
1.443     albertel 13147:                 my $uurl='/'.$cid;
                   13148:                 $uurl=~s/\_/\//g;
                   13149:                 if ($oldsec) {
                   13150:                     $uurl.='/'.$oldsec;
                   13151:                 }
1.626     raeburn  13152:                 $oldsecurl = $uurl;
1.628     raeburn  13153:                 $expire_role_result = 
1.652     raeburn  13154:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13155:                 if ($env{'request.course.sec'} ne '') { 
                   13156:                     if ($expire_role_result eq 'refused') {
                   13157:                         my @roles = ('st');
                   13158:                         my @statuses = ('previous');
                   13159:                         my @roledoms = ($one);
                   13160:                         my $withsec = 1;
                   13161:                         my %roleshash = 
                   13162:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13163:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13164:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13165:                             my ($oldstart,$oldend) = 
                   13166:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13167:                             if ($oldend > 0 && $oldend <= $now) {
                   13168:                                 $expire_role_result = 'ok';
                   13169:                             }
                   13170:                         }
                   13171:                     }
                   13172:                 }
1.443     albertel 13173:                 $result = $expire_role_result;
                   13174:             }
                   13175:         }
                   13176:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  13177:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 13178:             if ($modify_section_result =~ /^ok/) {
                   13179:                 if ($secchange == 1) {
1.628     raeburn  13180:                     if ($sec eq '') {
                   13181:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13182:                     } else {
                   13183:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13184:                     }
1.443     albertel 13185:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13186:                     if ($sec eq '') {
                   13187:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13188:                     } else {
                   13189:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13190:                     }
1.443     albertel 13191:                 } else {
1.628     raeburn  13192:                     if ($sec eq '') {
                   13193:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13194:                     } else {
                   13195:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13196:                     }
1.443     albertel 13197:                 }
                   13198:             } else {
1.628     raeburn  13199:                 if ($secchange) {       
                   13200:                     $$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;
                   13201:                 } else {
                   13202:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13203:                 }
1.443     albertel 13204:             }
                   13205:             $result = $modify_section_result;
                   13206:         } elsif ($secchange == 1) {
1.628     raeburn  13207:             if ($oldsec eq '') {
                   13208:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   13209:             } else {
                   13210:                 $$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;
                   13211:             }
1.626     raeburn  13212:             if ($expire_role_result eq 'refused') {
                   13213:                 my $newsecurl = '/'.$cid;
                   13214:                 $newsecurl =~ s/\_/\//g;
                   13215:                 if ($sec ne '') {
                   13216:                     $newsecurl.='/'.$sec;
                   13217:                 }
                   13218:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13219:                     if ($sec eq '') {
                   13220:                         $$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;
                   13221:                     } else {
                   13222:                         $$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;
                   13223:                     }
                   13224:                 }
                   13225:             }
1.443     albertel 13226:         }
                   13227:     } else {
1.626     raeburn  13228:         $$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 13229:         $result = "error: incomplete course id\n";
                   13230:     }
                   13231:     return $result;
                   13232: }
                   13233: 
                   13234: ############################################################
                   13235: ############################################################
                   13236: 
1.566     albertel 13237: sub check_clone {
1.578     raeburn  13238:     my ($args,$linefeed) = @_;
1.566     albertel 13239:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13240:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13241:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13242:     my $clonemsg;
                   13243:     my $can_clone = 0;
1.944     raeburn  13244:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13245:     if ($lctype ne 'community') {
                   13246:         $lctype = 'course';
                   13247:     }
1.566     albertel 13248:     if ($clonehome eq 'no_host') {
1.944     raeburn  13249:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13250:             $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   13251:         } else {
                   13252:             $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   13253:         }     
1.566     albertel 13254:     } else {
                   13255: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13256:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13257:             if ($clonedesc{'type'} ne 'Community') {
                   13258:                  $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   13259:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13260:             }
                   13261:         }
1.882     raeburn  13262: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13263:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13264: 	    $can_clone = 1;
                   13265: 	} else {
                   13266: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13267: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13268: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13269:             if (grep(/^\*$/,@cloners)) {
                   13270:                 $can_clone = 1;
                   13271:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13272:                 $can_clone = 1;
                   13273:             } else {
1.908     raeburn  13274:                 my $ccrole = 'cc';
1.944     raeburn  13275:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13276:                     $ccrole = 'co';
                   13277:                 }
1.578     raeburn  13278: 	        my %roleshash =
                   13279: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13280: 					 $args->{'ccdomain'},
1.908     raeburn  13281:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13282: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13283: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13284:                     $can_clone = 1;
                   13285:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13286:                     $can_clone = 1;
                   13287:                 } else {
1.944     raeburn  13288:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13289:                         $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                   13290:                     } else {
                   13291:                         $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                   13292:                     }
1.578     raeburn  13293: 	        }
1.566     albertel 13294: 	    }
1.578     raeburn  13295:         }
1.566     albertel 13296:     }
                   13297:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13298: }
                   13299: 
1.444     albertel 13300: sub construct_course {
1.885     raeburn  13301:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13302:     my $outcome;
1.541     raeburn  13303:     my $linefeed =  '<br />'."\n";
                   13304:     if ($context eq 'auto') {
                   13305:         $linefeed = "\n";
                   13306:     }
1.566     albertel 13307: 
                   13308: #
                   13309: # Are we cloning?
                   13310: #
                   13311:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13312:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13313: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13314: 	if ($context ne 'auto') {
1.578     raeburn  13315:             if ($clonemsg ne '') {
                   13316: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13317:             }
1.566     albertel 13318: 	}
                   13319: 	$outcome .= $clonemsg.$linefeed;
                   13320: 
                   13321:         if (!$can_clone) {
                   13322: 	    return (0,$outcome);
                   13323: 	}
                   13324:     }
                   13325: 
1.444     albertel 13326: #
                   13327: # Open course
                   13328: #
                   13329:     my $crstype = lc($args->{'crstype'});
                   13330:     my %cenv=();
                   13331:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13332:                                              $args->{'cdescr'},
                   13333:                                              $args->{'curl'},
                   13334:                                              $args->{'course_home'},
                   13335:                                              $args->{'nonstandard'},
                   13336:                                              $args->{'crscode'},
                   13337:                                              $args->{'ccuname'}.':'.
                   13338:                                              $args->{'ccdomain'},
1.882     raeburn  13339:                                              $args->{'crstype'},
1.885     raeburn  13340:                                              $cnum,$context,$category);
1.444     albertel 13341: 
                   13342:     # Note: The testing routines depend on this being output; see 
                   13343:     # Utils::Course. This needs to at least be output as a comment
                   13344:     # if anyone ever decides to not show this, and Utils::Course::new
                   13345:     # will need to be suitably modified.
1.541     raeburn  13346:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13347:     if ($$courseid =~ /^error:/) {
                   13348:         return (0,$outcome);
                   13349:     }
                   13350: 
1.444     albertel 13351: #
                   13352: # Check if created correctly
                   13353: #
1.479     albertel 13354:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13355:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13356:     if ($crsuhome eq 'no_host') {
                   13357:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13358:         return (0,$outcome);
                   13359:     }
1.541     raeburn  13360:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13361: 
1.444     albertel 13362: #
1.566     albertel 13363: # Do the cloning
                   13364: #   
                   13365:     if ($can_clone && $cloneid) {
                   13366: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13367: 	if ($context ne 'auto') {
                   13368: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13369: 	}
                   13370: 	$outcome .= $clonemsg.$linefeed;
                   13371: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13372: # Copy all files
1.637     www      13373: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13374: # Restore URL
1.566     albertel 13375: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13376: # Restore title
1.566     albertel 13377: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13378: # Restore creation date, creator and creation context.
                   13379:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13380:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13381:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13382: # Mark as cloned
1.566     albertel 13383: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13384: # Need to clone grading mode
                   13385:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13386:         $cenv{'grading'}=$newenv{'grading'};
                   13387: # Do not clone these environment entries
                   13388:         &Apache::lonnet::del('environment',
                   13389:                   ['default_enrollment_start_date',
                   13390:                    'default_enrollment_end_date',
                   13391:                    'question.email',
                   13392:                    'policy.email',
                   13393:                    'comment.email',
                   13394:                    'pch.users.denied',
1.725     raeburn  13395:                    'plc.users.denied',
                   13396:                    'hidefromcat',
                   13397:                    'categories'],
1.638     www      13398:                    $$crsudom,$$crsunum);
1.444     albertel 13399:     }
1.566     albertel 13400: 
1.444     albertel 13401: #
                   13402: # Set environment (will override cloned, if existing)
                   13403: #
                   13404:     my @sections = ();
                   13405:     my @xlists = ();
                   13406:     if ($args->{'crstype'}) {
                   13407:         $cenv{'type'}=$args->{'crstype'};
                   13408:     }
                   13409:     if ($args->{'crsid'}) {
                   13410:         $cenv{'courseid'}=$args->{'crsid'};
                   13411:     }
                   13412:     if ($args->{'crscode'}) {
                   13413:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13414:     }
                   13415:     if ($args->{'crsquota'} ne '') {
                   13416:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13417:     } else {
                   13418:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13419:     }
                   13420:     if ($args->{'ccuname'}) {
                   13421:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13422:                                         ':'.$args->{'ccdomain'};
                   13423:     } else {
                   13424:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13425:     }
                   13426:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13427:     if ($args->{'crssections'}) {
                   13428:         $cenv{'internal.sectionnums'} = '';
                   13429:         if ($args->{'crssections'} =~ m/,/) {
                   13430:             @sections = split/,/,$args->{'crssections'};
                   13431:         } else {
                   13432:             $sections[0] = $args->{'crssections'};
                   13433:         }
                   13434:         if (@sections > 0) {
                   13435:             foreach my $item (@sections) {
                   13436:                 my ($sec,$gp) = split/:/,$item;
                   13437:                 my $class = $args->{'crscode'}.$sec;
                   13438:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13439:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13440:                 unless ($addcheck eq 'ok') {
                   13441:                     push @badclasses, $class;
                   13442:                 }
                   13443:             }
                   13444:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13445:         }
                   13446:     }
                   13447: # do not hide course coordinator from staff listing, 
                   13448: # even if privileged
                   13449:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13450: # add crosslistings
                   13451:     if ($args->{'crsxlist'}) {
                   13452:         $cenv{'internal.crosslistings'}='';
                   13453:         if ($args->{'crsxlist'} =~ m/,/) {
                   13454:             @xlists = split/,/,$args->{'crsxlist'};
                   13455:         } else {
                   13456:             $xlists[0] = $args->{'crsxlist'};
                   13457:         }
                   13458:         if (@xlists > 0) {
                   13459:             foreach my $item (@xlists) {
                   13460:                 my ($xl,$gp) = split/:/,$item;
                   13461:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13462:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13463:                 unless ($addcheck eq 'ok') {
                   13464:                     push @badclasses, $xl;
                   13465:                 }
                   13466:             }
                   13467:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13468:         }
                   13469:     }
                   13470:     if ($args->{'autoadds'}) {
                   13471:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13472:     }
                   13473:     if ($args->{'autodrops'}) {
                   13474:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13475:     }
                   13476: # check for notification of enrollment changes
                   13477:     my @notified = ();
                   13478:     if ($args->{'notify_owner'}) {
                   13479:         if ($args->{'ccuname'} ne '') {
                   13480:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   13481:         }
                   13482:     }
                   13483:     if ($args->{'notify_dc'}) {
                   13484:         if ($uname ne '') { 
1.630     raeburn  13485:             push(@notified,$uname.':'.$udom);
1.444     albertel 13486:         }
                   13487:     }
                   13488:     if (@notified > 0) {
                   13489:         my $notifylist;
                   13490:         if (@notified > 1) {
                   13491:             $notifylist = join(',',@notified);
                   13492:         } else {
                   13493:             $notifylist = $notified[0];
                   13494:         }
                   13495:         $cenv{'internal.notifylist'} = $notifylist;
                   13496:     }
                   13497:     if (@badclasses > 0) {
                   13498:         my %lt=&Apache::lonlocal::texthash(
                   13499:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
                   13500:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   13501:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   13502:         );
1.541     raeburn  13503:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   13504:                            ' ('.$lt{'adby'}.')';
                   13505:         if ($context eq 'auto') {
                   13506:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 13507:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  13508:             foreach my $item (@badclasses) {
                   13509:                 if ($context eq 'auto') {
                   13510:                     $outcome .= " - $item\n";
                   13511:                 } else {
                   13512:                     $outcome .= "<li>$item</li>\n";
                   13513:                 }
                   13514:             }
                   13515:             if ($context eq 'auto') {
                   13516:                 $outcome .= $linefeed;
                   13517:             } else {
1.566     albertel 13518:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  13519:             }
                   13520:         } 
1.444     albertel 13521:     }
                   13522:     if ($args->{'no_end_date'}) {
                   13523:         $args->{'endaccess'} = 0;
                   13524:     }
                   13525:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   13526:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   13527:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   13528:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   13529:     if ($args->{'showphotos'}) {
                   13530:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   13531:     }
                   13532:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   13533:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   13534:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   13535:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  13536:             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'); 
                   13537:             if ($context eq 'auto') {
                   13538:                 $outcome .= $krb_msg;
                   13539:             } else {
1.566     albertel 13540:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  13541:             }
                   13542:             $outcome .= $linefeed;
1.444     albertel 13543:         }
                   13544:     }
                   13545:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   13546:        if ($args->{'setpolicy'}) {
                   13547:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13548:        }
                   13549:        if ($args->{'setcontent'}) {
                   13550:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13551:        }
                   13552:     }
                   13553:     if ($args->{'reshome'}) {
                   13554: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   13555: 	$cenv{'reshome'}=~s/\/+$/\//;
                   13556:     }
                   13557: #
                   13558: # course has keyed access
                   13559: #
                   13560:     if ($args->{'setkeys'}) {
                   13561:        $cenv{'keyaccess'}='yes';
                   13562:     }
                   13563: # if specified, key authority is not course, but user
                   13564: # only active if keyaccess is yes
                   13565:     if ($args->{'keyauth'}) {
1.487     albertel 13566: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   13567: 	$user = &LONCAPA::clean_username($user);
                   13568: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     13569: 	if ($user ne '' && $domain ne '') {
1.487     albertel 13570: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 13571: 	}
                   13572:     }
                   13573: 
                   13574:     if ($args->{'disresdis'}) {
                   13575:         $cenv{'pch.roles.denied'}='st';
                   13576:     }
                   13577:     if ($args->{'disablechat'}) {
                   13578:         $cenv{'plc.roles.denied'}='st';
                   13579:     }
                   13580: 
                   13581:     # Record we've not yet viewed the Course Initialization Helper for this 
                   13582:     # course
                   13583:     $cenv{'course.helper.not.run'} = 1;
                   13584:     #
                   13585:     # Use new Randomseed
                   13586:     #
                   13587:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   13588:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   13589:     #
                   13590:     # The encryption code and receipt prefix for this course
                   13591:     #
                   13592:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   13593:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   13594:     #
                   13595:     # By default, use standard grading
                   13596:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   13597: 
1.541     raeburn  13598:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   13599:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13600: #
                   13601: # Open all assignments
                   13602: #
                   13603:     if ($args->{'openall'}) {
                   13604:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   13605:        my %storecontent = ($storeunder         => time,
                   13606:                            $storeunder.'.type' => 'date_start');
                   13607:        
                   13608:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  13609:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13610:    }
                   13611: #
                   13612: # Set first page
                   13613: #
                   13614:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   13615: 	    || ($cloneid)) {
1.445     albertel 13616: 	use LONCAPA::map;
1.444     albertel 13617: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 13618: 
                   13619: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   13620:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   13621: 
1.444     albertel 13622:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   13623:         my $title; my $url;
                   13624:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   13625: 	    $title=&mt('Syllabus');
1.444     albertel 13626:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   13627:         } else {
1.963     raeburn  13628:             $title=&mt('Table of Contents');
1.444     albertel 13629:             $url='/adm/navmaps';
                   13630:         }
1.445     albertel 13631: 
                   13632:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   13633: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   13634: 
                   13635: 	if ($errtext) { $fatal=2; }
1.541     raeburn  13636:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 13637:     }
1.566     albertel 13638: 
                   13639:     return (1,$outcome);
1.444     albertel 13640: }
                   13641: 
                   13642: ############################################################
                   13643: ############################################################
                   13644: 
1.953     droeschl 13645: #SD
                   13646: # only Community and Course, or anything else?
1.378     raeburn  13647: sub course_type {
                   13648:     my ($cid) = @_;
                   13649:     if (!defined($cid)) {
                   13650:         $cid = $env{'request.course.id'};
                   13651:     }
1.404     albertel 13652:     if (defined($env{'course.'.$cid.'.type'})) {
                   13653:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  13654:     } else {
                   13655:         return 'Course';
1.377     raeburn  13656:     }
                   13657: }
1.156     albertel 13658: 
1.406     raeburn  13659: sub group_term {
                   13660:     my $crstype = &course_type();
                   13661:     my %names = (
                   13662:                   'Course' => 'group',
1.865     raeburn  13663:                   'Community' => 'group',
1.406     raeburn  13664:                 );
                   13665:     return $names{$crstype};
                   13666: }
                   13667: 
1.902     raeburn  13668: sub course_types {
                   13669:     my @types = ('official','unofficial','community');
                   13670:     my %typename = (
                   13671:                          official   => 'Official course',
                   13672:                          unofficial => 'Unofficial course',
                   13673:                          community  => 'Community',
                   13674:                    );
                   13675:     return (\@types,\%typename);
                   13676: }
                   13677: 
1.156     albertel 13678: sub icon {
                   13679:     my ($file)=@_;
1.505     albertel 13680:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 13681:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 13682:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 13683:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   13684: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   13685: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13686: 	            $curfext.".gif") {
                   13687: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13688: 		$curfext.".gif";
                   13689: 	}
                   13690:     }
1.249     albertel 13691:     return &lonhttpdurl($iconname);
1.154     albertel 13692: } 
1.84      albertel 13693: 
1.575     albertel 13694: sub lonhttpdurl {
1.692     www      13695: #
                   13696: # Had been used for "small fry" static images on separate port 8080.
                   13697: # Modify here if lightweight http functionality desired again.
                   13698: # Currently eliminated due to increasing firewall issues.
                   13699: #
1.575     albertel 13700:     my ($url)=@_;
1.692     www      13701:     return $url;
1.215     albertel 13702: }
                   13703: 
1.213     albertel 13704: sub connection_aborted {
                   13705:     my ($r)=@_;
                   13706:     $r->print(" ");$r->rflush();
                   13707:     my $c = $r->connection;
                   13708:     return $c->aborted();
                   13709: }
                   13710: 
1.221     foxr     13711: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     13712: #    strings as 'strings'.
                   13713: sub escape_single {
1.221     foxr     13714:     my ($input) = @_;
1.223     albertel 13715:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     13716:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   13717:     return $input;
                   13718: }
1.223     albertel 13719: 
1.222     foxr     13720: #  Same as escape_single, but escape's "'s  This 
                   13721: #  can be used for  "strings"
                   13722: sub escape_double {
                   13723:     my ($input) = @_;
                   13724:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   13725:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   13726:     return $input;
                   13727: }
1.223     albertel 13728:  
1.222     foxr     13729: #   Escapes the last element of a full URL.
                   13730: sub escape_url {
                   13731:     my ($url)   = @_;
1.238     raeburn  13732:     my @urlslices = split(/\//, $url,-1);
1.369     www      13733:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 13734:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     13735: }
1.462     albertel 13736: 
1.820     raeburn  13737: sub compare_arrays {
                   13738:     my ($arrayref1,$arrayref2) = @_;
                   13739:     my (@difference,%count);
                   13740:     @difference = ();
                   13741:     %count = ();
                   13742:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   13743:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   13744:         foreach my $element (keys(%count)) {
                   13745:             if ($count{$element} == 1) {
                   13746:                 push(@difference,$element);
                   13747:             }
                   13748:         }
                   13749:     }
                   13750:     return @difference;
                   13751: }
                   13752: 
1.817     bisitz   13753: # -------------------------------------------------------- Initialize user login
1.462     albertel 13754: sub init_user_environment {
1.463     albertel 13755:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 13756:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   13757: 
                   13758:     my $public=($username eq 'public' && $domain eq 'public');
                   13759: 
                   13760: # See if old ID present, if so, remove
                   13761: 
1.1062    raeburn  13762:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 13763:     my $now=time;
                   13764: 
                   13765:     if ($public) {
                   13766: 	my $max_public=100;
                   13767: 	my $oldest;
                   13768: 	my $oldest_time=0;
                   13769: 	for(my $next=1;$next<=$max_public;$next++) {
                   13770: 	    if (-e $lonids."/publicuser_$next.id") {
                   13771: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   13772: 		if ($mtime<$oldest_time || !$oldest_time) {
                   13773: 		    $oldest_time=$mtime;
                   13774: 		    $oldest=$next;
                   13775: 		}
                   13776: 	    } else {
                   13777: 		$cookie="publicuser_$next";
                   13778: 		last;
                   13779: 	    }
                   13780: 	}
                   13781: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   13782:     } else {
1.463     albertel 13783: 	# if this isn't a robot, kill any existing non-robot sessions
                   13784: 	if (!$args->{'robot'}) {
                   13785: 	    opendir(DIR,$lonids);
                   13786: 	    while ($filename=readdir(DIR)) {
                   13787: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   13788: 		    unlink($lonids.'/'.$filename);
                   13789: 		}
1.462     albertel 13790: 	    }
1.463     albertel 13791: 	    closedir(DIR);
1.462     albertel 13792: 	}
                   13793: # Give them a new cookie
1.463     albertel 13794: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      13795: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 13796: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 13797:     
                   13798: # Initialize roles
                   13799: 
1.1062    raeburn  13800: 	($userroles,$firstaccenv,$timerintenv) = 
                   13801:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 13802:     }
                   13803: # ------------------------------------ Check browser type and MathML capability
                   13804: 
                   13805:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   13806:         $clientunicode,$clientos) = &decode_user_agent($r);
                   13807: 
                   13808: # ------------------------------------------------------------- Get environment
                   13809: 
                   13810:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   13811:     my ($tmp) = keys(%userenv);
                   13812:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   13813:     } else {
                   13814: 	undef(%userenv);
                   13815:     }
                   13816:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   13817: 	$form->{'interface'}=$userenv{'interface'};
                   13818:     }
                   13819:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   13820: 
                   13821: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   13822:     foreach my $option ('interface','localpath','localres') {
                   13823:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 13824:     }
                   13825: # --------------------------------------------------------- Write first profile
                   13826: 
                   13827:     {
                   13828: 	my %initial_env = 
                   13829: 	    ("user.name"          => $username,
                   13830: 	     "user.domain"        => $domain,
                   13831: 	     "user.home"          => $authhost,
                   13832: 	     "browser.type"       => $clientbrowser,
                   13833: 	     "browser.version"    => $clientversion,
                   13834: 	     "browser.mathml"     => $clientmathml,
                   13835: 	     "browser.unicode"    => $clientunicode,
                   13836: 	     "browser.os"         => $clientos,
                   13837: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   13838: 	     "request.course.fn"  => '',
                   13839: 	     "request.course.uri" => '',
                   13840: 	     "request.course.sec" => '',
                   13841: 	     "request.role"       => 'cm',
                   13842: 	     "request.role.adv"   => $env{'user.adv'},
                   13843: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   13844: 
                   13845:         if ($form->{'localpath'}) {
                   13846: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   13847: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   13848:         }
                   13849: 	
                   13850: 	if ($form->{'interface'}) {
                   13851: 	    $form->{'interface'}=~s/\W//gs;
                   13852: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   13853: 	    $env{'browser.interface'}=$form->{'interface'};
                   13854: 	}
                   13855: 
1.981     raeburn  13856:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  13857:         my %domdef;
                   13858:         unless ($domain eq 'public') {
                   13859:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   13860:         }
1.980     raeburn  13861: 
1.1081    raeburn  13862:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  13863:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  13864:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   13865:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  13866:         }
                   13867: 
1.864     raeburn  13868:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  13869:             $userenv{'canrequest.'.$crstype} =
                   13870:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  13871:                                                   'reload','requestcourses',
                   13872:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  13873:         }
                   13874: 
1.1092  ! raeburn  13875:         $userenv{'canrequest.author'} =
        !          13876:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
        !          13877:                                         'reload','requestauthor',
        !          13878:                                         \%userenv,\%domdef,\%is_adv);
        !          13879:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
        !          13880:                                              $domain,$username);
        !          13881:         my $reqstatus = $reqauthor{'author_status'};
        !          13882:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
        !          13883:             if (ref($reqauthor{'author'}) eq 'HASH') {
        !          13884:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
        !          13885:                                                   $reqauthor{'author'}{'timestamp'};
        !          13886:             }
        !          13887:         }
        !          13888: 
1.462     albertel 13889: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  13890: 
1.462     albertel 13891: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   13892: 		 &GDBM_WRCREAT(),0640)) {
                   13893: 	    &_add_to_env(\%disk_env,\%initial_env);
                   13894: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   13895: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  13896:             if (ref($firstaccenv) eq 'HASH') {
                   13897:                 &_add_to_env(\%disk_env,$firstaccenv);
                   13898:             }
                   13899:             if (ref($timerintenv) eq 'HASH') {
                   13900:                 &_add_to_env(\%disk_env,$timerintenv);
                   13901:             }
1.463     albertel 13902: 	    if (ref($args->{'extra_env'})) {
                   13903: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   13904: 	    }
1.462     albertel 13905: 	    untie(%disk_env);
                   13906: 	} else {
1.705     tempelho 13907: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   13908: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 13909: 	    return 'error: '.$!;
                   13910: 	}
                   13911:     }
                   13912:     $env{'request.role'}='cm';
                   13913:     $env{'request.role.adv'}=$env{'user.adv'};
                   13914:     $env{'browser.type'}=$clientbrowser;
                   13915: 
                   13916:     return $cookie;
                   13917: 
                   13918: }
                   13919: 
                   13920: sub _add_to_env {
                   13921:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  13922:     if (ref($env_data) eq 'HASH') {
                   13923:         while (my ($key,$value) = each(%$env_data)) {
                   13924: 	    $idf->{$prefix.$key} = $value;
                   13925: 	    $env{$prefix.$key}   = $value;
                   13926:         }
1.462     albertel 13927:     }
                   13928: }
                   13929: 
1.685     tempelho 13930: # --- Get the symbolic name of a problem and the url
                   13931: sub get_symb {
                   13932:     my ($request,$silent) = @_;
1.726     raeburn  13933:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 13934:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   13935:     if ($symb eq '') {
                   13936:         if (!$silent) {
1.1071    raeburn  13937:             if (ref($request)) { 
                   13938:                 $request->print("Unable to handle ambiguous references:$url:.");
                   13939:             }
1.685     tempelho 13940:             return ();
                   13941:         }
                   13942:     }
                   13943:     &Apache::lonenc::check_decrypt(\$symb);
                   13944:     return ($symb);
                   13945: }
                   13946: 
                   13947: # --------------------------------------------------------------Get annotation
                   13948: 
                   13949: sub get_annotation {
                   13950:     my ($symb,$enc) = @_;
                   13951: 
                   13952:     my $key = $symb;
                   13953:     if (!$enc) {
                   13954:         $key =
                   13955:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   13956:     }
                   13957:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   13958:     return $annotation{$key};
                   13959: }
                   13960: 
                   13961: sub clean_symb {
1.731     raeburn  13962:     my ($symb,$delete_enc) = @_;
1.685     tempelho 13963: 
                   13964:     &Apache::lonenc::check_decrypt(\$symb);
                   13965:     my $enc = $env{'request.enc'};
1.731     raeburn  13966:     if ($delete_enc) {
1.730     raeburn  13967:         delete($env{'request.enc'});
                   13968:     }
1.685     tempelho 13969: 
                   13970:     return ($symb,$enc);
                   13971: }
1.462     albertel 13972: 
1.990     raeburn  13973: sub build_release_hashes {
                   13974:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   13975:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   13976:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   13977:                   (ref($randomizetry) eq 'HASH'));
                   13978:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   13979:         my ($item,$name,$value) = split(/:/,$key);
                   13980:         if ($item eq 'parameter') {
                   13981:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   13982:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   13983:                     push(@{$checkparms->{$name}},$value);
                   13984:                 }
                   13985:             } else {
                   13986:                 push(@{$checkparms->{$name}},$value);
                   13987:             }
                   13988:         } elsif ($item eq 'resourcetag') {
                   13989:             if ($name eq 'responsetype') {
                   13990:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   13991:             }
                   13992:         } elsif ($item eq 'course') {
                   13993:             if ($name eq 'crstype') {
                   13994:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   13995:             }
                   13996:         }
                   13997:     }
                   13998:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   13999:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14000:     return;
                   14001: }
                   14002: 
1.1083    raeburn  14003: sub update_content_constraints {
                   14004:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14005:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14006:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14007:     my %checkresponsetypes;
                   14008:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14009:         my ($item,$name,$value) = split(/:/,$key);
                   14010:         if ($item eq 'resourcetag') {
                   14011:             if ($name eq 'responsetype') {
                   14012:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14013:             }
                   14014:         }
                   14015:     }
                   14016:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14017:     if (defined($navmap)) {
                   14018:         my %allresponses;
                   14019:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14020:             my %responses = $res->responseTypes();
                   14021:             foreach my $key (keys(%responses)) {
                   14022:                 next unless(exists($checkresponsetypes{$key}));
                   14023:                 $allresponses{$key} += $responses{$key};
                   14024:             }
                   14025:         }
                   14026:         foreach my $key (keys(%allresponses)) {
                   14027:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14028:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14029:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14030:             }
                   14031:         }
                   14032:         undef($navmap);
                   14033:     }
                   14034:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14035:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14036:     }
                   14037:     return;
                   14038: }
                   14039: 
                   14040: sub parse_supplemental_title {
                   14041:     my ($title) = @_;
                   14042: 
                   14043:     my ($foldertitle,$renametitle);
                   14044:     if ($title =~ /&amp;&amp;&amp;/) {
                   14045:         $title = &HTML::Entites::decode($title);
                   14046:     }
                   14047:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14048:         $renametitle=$4;
                   14049:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14050:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14051:         my $name =  &plainname($uname,$udom);
                   14052:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14053:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14054:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14055:             $name.': <br />'.$foldertitle;
                   14056:     }
                   14057:     if (wantarray) {
                   14058:         return ($title,$foldertitle,$renametitle);
                   14059:     }
                   14060:     return $title;
                   14061: }
                   14062: 
1.41      ng       14063: =pod
                   14064: 
                   14065: =back
                   14066: 
1.112     bowersj2 14067: =cut
1.41      ng       14068: 
1.112     bowersj2 14069: 1;
                   14070: __END__;
1.41      ng       14071: 

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