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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1075.2.25! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.24 2012/12/28 02:03:13 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1075.2.25! raeburn    70: use Apache::lonuserutils();
1.479     albertel   71: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    72: use DateTime::TimeZone;
1.687     raeburn    73: use DateTime::Locale::Catalog;
1.1075.2.14  raeburn    74: use Authen::Captcha;
                     75: use Captcha::reCAPTCHA;
1.117     www        76: 
1.517     raeburn    77: # ---------------------------------------------- Designs
                     78: use vars qw(%defaultdesign);
                     79: 
1.22      www        80: my $readit;
                     81: 
1.517     raeburn    82: 
1.157     matthew    83: ##
                     84: ## Global Variables
                     85: ##
1.46      matthew    86: 
1.643     foxr       87: 
                     88: # ----------------------------------------------- SSI with retries:
                     89: #
                     90: 
                     91: =pod
                     92: 
1.648     raeburn    93: =head1 Server Side include with retries:
1.643     foxr       94: 
                     95: =over 4
                     96: 
1.648     raeburn    97: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       98: 
                     99: Performs an ssi with some number of retries.  Retries continue either
                    100: until the result is ok or until the retry count supplied by the
                    101: caller is exhausted.  
                    102: 
                    103: Inputs:
1.648     raeburn   104: 
                    105: =over 4
                    106: 
1.643     foxr      107: resource   - Identifies the resource to insert.
1.648     raeburn   108: 
1.643     foxr      109: retries    - Count of the number of retries allowed.
1.648     raeburn   110: 
1.643     foxr      111: form       - Hash that identifies the rendering options.
                    112: 
1.648     raeburn   113: =back
                    114: 
                    115: Returns:
                    116: 
                    117: =over 4
                    118: 
1.643     foxr      119: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   120: 
1.643     foxr      121: response   - The response from the last attempt (which may or may not have been successful.
                    122: 
1.648     raeburn   123: =back
                    124: 
                    125: =back
                    126: 
1.643     foxr      127: =cut
                    128: 
                    129: sub ssi_with_retries {
                    130:     my ($resource, $retries, %form) = @_;
                    131: 
                    132: 
                    133:     my $ok = 0;			# True if we got a good response.
                    134:     my $content;
                    135:     my $response;
                    136: 
                    137:     # Try to get the ssi done. within the retries count:
                    138: 
                    139:     do {
                    140: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    141: 	$ok      = $response->is_success;
1.650     www       142:         if (!$ok) {
                    143:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    144:         }
1.643     foxr      145: 	$retries--;
                    146:     } while (!$ok && ($retries > 0));
                    147: 
                    148:     if (!$ok) {
                    149: 	$content = '';		# On error return an empty content.
                    150:     }
                    151:     return ($content, $response);
                    152: 
                    153: }
                    154: 
                    155: 
                    156: 
1.20      www       157: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  158: my %language;
1.124     www       159: my %supported_language;
1.1048    foxr      160: my %latex_language;		# For choosing hyphenation in <transl..>
                    161: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  162: my %cprtag;
1.192     taceyjo1  163: my %scprtag;
1.351     www       164: my %fe; my %fd; my %fm;
1.41      ng        165: my %category_extensions;
1.12      harris41  166: 
1.46      matthew   167: # ---------------------------------------------- Thesaurus variables
1.144     matthew   168: #
                    169: # %Keywords:
                    170: #      A hash used by &keyword to determine if a word is considered a keyword.
                    171: # $thesaurus_db_file 
                    172: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   173: 
                    174: my %Keywords;
                    175: my $thesaurus_db_file;
                    176: 
1.144     matthew   177: #
                    178: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    179: # thesaurus.tab, and filecategories.tab.
                    180: #
1.18      www       181: BEGIN {
1.46      matthew   182:     # Variable initialization
                    183:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    184:     #
1.22      www       185:     unless ($readit) {
1.12      harris41  186: # ------------------------------------------------------------------- languages
                    187:     {
1.158     raeburn   188:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    189:                                    '/language.tab';
                    190:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  191:             while (my $line = <$fh>) {
                    192:                 next if ($line=~/^\#/);
                    193:                 chomp($line);
1.1048    foxr      194:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   195:                 $language{$key}=$val.' - '.$enc;
                    196:                 if ($sup) {
                    197:                     $supported_language{$key}=$sup;
                    198:                 }
1.1048    foxr      199: 		if ($latex) {
                    200: 		    $latex_language_bykey{$key} = $latex;
                    201: 		    $latex_language{$two} = $latex;
                    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]);
                    663:             if (n !== n) { // shortcut for verifying if it's NaN
                    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++) {
1.1075.2.14  raeburn   891:             if (!field[i].disabled) {
                    892:                 field[i].checked = true;
                    893:             }
1.273     raeburn   894:         }
                    895:     } else {
1.1075.2.14  raeburn   896:         if (!field.disabled) {
                    897:             field.checked = true;
                    898:         }
1.273     raeburn   899:     }
                    900: }
                    901:  
                    902: function uncheckAll(field) {
                    903:     if (field.length > 0) {
                    904:         for (i = 0; i < field.length; i++) {
                    905:             field[i].checked = false ;
1.543     albertel  906:         }
                    907:     } else {
1.273     raeburn   908:         field.checked = false ;
                    909:     }
                    910: }
                    911: ENDSCRT
                    912:     return $jscript;
                    913: }
                    914: 
1.656     www       915: sub select_timezone {
1.659     raeburn   916:    my ($name,$selected,$onchange,$includeempty)=@_;
                    917:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    918:    if ($includeempty) {
                    919:        $output .= '<option value=""';
                    920:        if (($selected eq '') || ($selected eq 'local')) {
                    921:            $output .= ' selected="selected" ';
                    922:        }
                    923:        $output .= '> </option>';
                    924:    }
1.657     raeburn   925:    my @timezones = DateTime::TimeZone->all_names;
                    926:    foreach my $tzone (@timezones) {
                    927:        $output.= '<option value="'.$tzone.'"';
                    928:        if ($tzone eq $selected) {
                    929:            $output.=' selected="selected"';
                    930:        }
                    931:        $output.=">$tzone</option>\n";
1.656     www       932:    }
                    933:    $output.="</select>";
                    934:    return $output;
                    935: }
1.273     raeburn   936: 
1.687     raeburn   937: sub select_datelocale {
                    938:     my ($name,$selected,$onchange,$includeempty)=@_;
                    939:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    940:     if ($includeempty) {
                    941:         $output .= '<option value=""';
                    942:         if ($selected eq '') {
                    943:             $output .= ' selected="selected" ';
                    944:         }
                    945:         $output .= '> </option>';
                    946:     }
                    947:     my (@possibles,%locale_names);
                    948:     my @locales = DateTime::Locale::Catalog::Locales;
                    949:     foreach my $locale (@locales) {
                    950:         if (ref($locale) eq 'HASH') {
                    951:             my $id = $locale->{'id'};
                    952:             if ($id ne '') {
                    953:                 my $en_terr = $locale->{'en_territory'};
                    954:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   955:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   956:                 if (grep(/^en$/,@languages) || !@languages) {
                    957:                     if ($en_terr ne '') {
                    958:                         $locale_names{$id} = '('.$en_terr.')';
                    959:                     } elsif ($native_terr ne '') {
                    960:                         $locale_names{$id} = $native_terr;
                    961:                     }
                    962:                 } else {
                    963:                     if ($native_terr ne '') {
                    964:                         $locale_names{$id} = $native_terr.' ';
                    965:                     } elsif ($en_terr ne '') {
                    966:                         $locale_names{$id} = '('.$en_terr.')';
                    967:                     }
                    968:                 }
                    969:                 push (@possibles,$id);
                    970:             }
                    971:         }
                    972:     }
                    973:     foreach my $item (sort(@possibles)) {
                    974:         $output.= '<option value="'.$item.'"';
                    975:         if ($item eq $selected) {
                    976:             $output.=' selected="selected"';
                    977:         }
                    978:         $output.=">$item";
                    979:         if ($locale_names{$item} ne '') {
                    980:             $output.="  $locale_names{$item}</option>\n";
                    981:         }
                    982:         $output.="</option>\n";
                    983:     }
                    984:     $output.="</select>";
                    985:     return $output;
                    986: }
                    987: 
1.792     raeburn   988: sub select_language {
                    989:     my ($name,$selected,$includeempty) = @_;
                    990:     my %langchoices;
                    991:     if ($includeempty) {
                    992:         %langchoices = ('' => 'No language preference');
                    993:     }
                    994:     foreach my $id (&languageids()) {
                    995:         my $code = &supportedlanguagecode($id);
                    996:         if ($code) {
                    997:             $langchoices{$code} = &plainlanguagedescription($id);
                    998:         }
                    999:     }
1.970     raeburn  1000:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1001: }
                   1002: 
1.42      matthew  1003: =pod
1.36      matthew  1004: 
1.648     raeburn  1005: =item * &linked_select_forms(...)
1.36      matthew  1006: 
                   1007: linked_select_forms returns a string containing a <script></script> block
                   1008: and html for two <select> menus.  The select menus will be linked in that
                   1009: changing the value of the first menu will result in new values being placed
                   1010: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1011: order unless a defined order is provided.
1.36      matthew  1012: 
                   1013: linked_select_forms takes the following ordered inputs:
                   1014: 
                   1015: =over 4
                   1016: 
1.112     bowersj2 1017: =item * $formname, the name of the <form> tag
1.36      matthew  1018: 
1.112     bowersj2 1019: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1020: 
1.112     bowersj2 1021: =item * $firstdefault, the default value for the first menu
1.36      matthew  1022: 
1.112     bowersj2 1023: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1024: 
1.112     bowersj2 1025: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1026: 
1.112     bowersj2 1027: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1028: 
1.609     raeburn  1029: =item * $menuorder, the order of values in the first menu
                   1030: 
1.41      ng       1031: =back 
                   1032: 
1.36      matthew  1033: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1034: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1035: values for the first select menu.  The text that coincides with the 
1.41      ng       1036: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1037: and text for the second menu are given in the hash pointed to by 
                   1038: $menu{$choice1}->{'select2'}.  
                   1039: 
1.112     bowersj2 1040:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1041:                        default => "B3",
                   1042:                        select2 => { 
                   1043:                            B1 => "Choice B1",
                   1044:                            B2 => "Choice B2",
                   1045:                            B3 => "Choice B3",
                   1046:                            B4 => "Choice B4"
1.609     raeburn  1047:                            },
                   1048:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1049:                    },
                   1050:                A2 => { text =>"Choice A2" ,
                   1051:                        default => "C2",
                   1052:                        select2 => { 
                   1053:                            C1 => "Choice C1",
                   1054:                            C2 => "Choice C2",
                   1055:                            C3 => "Choice C3"
1.609     raeburn  1056:                            },
                   1057:                        order => ['C2','C1','C3'],
1.112     bowersj2 1058:                    },
                   1059:                A3 => { text =>"Choice A3" ,
                   1060:                        default => "D6",
                   1061:                        select2 => { 
                   1062:                            D1 => "Choice D1",
                   1063:                            D2 => "Choice D2",
                   1064:                            D3 => "Choice D3",
                   1065:                            D4 => "Choice D4",
                   1066:                            D5 => "Choice D5",
                   1067:                            D6 => "Choice D6",
                   1068:                            D7 => "Choice D7"
1.609     raeburn  1069:                            },
                   1070:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1071:                    }
                   1072:                );
1.36      matthew  1073: 
                   1074: =cut
                   1075: 
                   1076: sub linked_select_forms {
                   1077:     my ($formname,
                   1078:         $middletext,
                   1079:         $firstdefault,
                   1080:         $firstselectname,
                   1081:         $secondselectname, 
1.609     raeburn  1082:         $hashref,
                   1083:         $menuorder,
1.36      matthew  1084:         ) = @_;
                   1085:     my $second = "document.$formname.$secondselectname";
                   1086:     my $first = "document.$formname.$firstselectname";
                   1087:     # output the javascript to do the changing
                   1088:     my $result = '';
1.776     bisitz   1089:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1090:     $result.="// <![CDATA[\n";
1.36      matthew  1091:     $result.="var select2data = new Object();\n";
                   1092:     $" = '","';
                   1093:     my $debug = '';
                   1094:     foreach my $s1 (sort(keys(%$hashref))) {
                   1095:         $result.="select2data.d_$s1 = new Object();\n";        
                   1096:         $result.="select2data.d_$s1.def = new String('".
                   1097:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1098:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1099:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1100:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1101:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1102:         }
1.36      matthew  1103:         $result.="\"@s2values\");\n";
                   1104:         $result.="select2data.d_$s1.texts = new Array(";        
                   1105:         my @s2texts;
                   1106:         foreach my $value (@s2values) {
                   1107:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1108:         }
                   1109:         $result.="\"@s2texts\");\n";
                   1110:     }
                   1111:     $"=' ';
                   1112:     $result.= <<"END";
                   1113: 
                   1114: function select1_changed() {
                   1115:     // Determine new choice
                   1116:     var newvalue = "d_" + $first.value;
                   1117:     // update select2
                   1118:     var values     = select2data[newvalue].values;
                   1119:     var texts      = select2data[newvalue].texts;
                   1120:     var select2def = select2data[newvalue].def;
                   1121:     var i;
                   1122:     // out with the old
                   1123:     for (i = 0; i < $second.options.length; i++) {
                   1124:         $second.options[i] = null;
                   1125:     }
                   1126:     // in with the nuclear
                   1127:     for (i=0;i<values.length; i++) {
                   1128:         $second.options[i] = new Option(values[i]);
1.143     matthew  1129:         $second.options[i].value = values[i];
1.36      matthew  1130:         $second.options[i].text = texts[i];
                   1131:         if (values[i] == select2def) {
                   1132:             $second.options[i].selected = true;
                   1133:         }
                   1134:     }
                   1135: }
1.824     bisitz   1136: // ]]>
1.36      matthew  1137: </script>
                   1138: END
                   1139:     # output the initial values for the selection lists
                   1140:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1141:     my @order = sort(keys(%{$hashref}));
                   1142:     if (ref($menuorder) eq 'ARRAY') {
                   1143:         @order = @{$menuorder};
                   1144:     }
                   1145:     foreach my $value (@order) {
1.36      matthew  1146:         $result.="    <option value=\"$value\" ";
1.253     albertel 1147:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1148:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1149:     }
                   1150:     $result .= "</select>\n";
                   1151:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1152:     $result .= $middletext;
                   1153:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1154:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1155:     
                   1156:     my @secondorder = sort(keys(%select2));
                   1157:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1158:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1159:     }
                   1160:     foreach my $value (@secondorder) {
1.36      matthew  1161:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1162:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1163:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1164:     }
                   1165:     $result .= "</select>\n";
                   1166:     #    return $debug;
                   1167:     return $result;
                   1168: }   #  end of sub linked_select_forms {
                   1169: 
1.45      matthew  1170: =pod
1.44      bowersj2 1171: 
1.973     raeburn  1172: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1173: 
1.112     bowersj2 1174: Returns a string corresponding to an HTML link to the given help
                   1175: $topic, where $topic corresponds to the name of a .tex file in
                   1176: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1177: spaces. 
                   1178: 
                   1179: $text will optionally be linked to the same topic, allowing you to
                   1180: link text in addition to the graphic. If you do not want to link
                   1181: text, but wish to specify one of the later parameters, pass an
                   1182: empty string. 
                   1183: 
                   1184: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1185: the link will not open a new window. If false, the link will open
                   1186: a new window using Javascript. (Default is false.) 
                   1187: 
                   1188: $width and $height are optional numerical parameters that will
                   1189: override the width and height of the popped up window, which may
1.973     raeburn  1190: be useful for certain help topics with big pictures included.
                   1191: 
                   1192: $imgid is the id of the img tag used for the help icon. This may be
                   1193: used in a javascript call to switch the image src.  See 
                   1194: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1195: 
                   1196: =cut
                   1197: 
                   1198: sub help_open_topic {
1.973     raeburn  1199:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1200:     $text = "" if (not defined $text);
1.44      bowersj2 1201:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1202:     $width = 500 if (not defined $width);
1.44      bowersj2 1203:     $height = 400 if (not defined $height);
                   1204:     my $filename = $topic;
                   1205:     $filename =~ s/ /_/g;
                   1206: 
1.48      bowersj2 1207:     my $template = "";
                   1208:     my $link;
1.572     banghart 1209:     
1.159     www      1210:     $topic=~s/\W/\_/g;
1.44      bowersj2 1211: 
1.572     banghart 1212:     if (!$stayOnPage) {
1.1033    www      1213: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1214:     } elsif ($stayOnPage eq 'popup') {
                   1215:         $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 1216:     } else {
1.48      bowersj2 1217: 	$link = "/adm/help/${filename}.hlp";
                   1218:     }
                   1219: 
                   1220:     # Add the text
1.755     neumanie 1221:     if ($text ne "") {	
1.763     bisitz   1222: 	$template.='<span class="LC_help_open_topic">'
                   1223:                   .'<a target="_top" href="'.$link.'">'
                   1224:                   .$text.'</a>';
1.48      bowersj2 1225:     }
                   1226: 
1.763     bisitz   1227:     # (Always) Add the graphic
1.179     matthew  1228:     my $title = &mt('Online Help');
1.667     raeburn  1229:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1230:     if ($imgid ne '') {
                   1231:         $imgid = ' id="'.$imgid.'"';
                   1232:     }
1.763     bisitz   1233:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1234:               .'<img src="'.$helpicon.'" border="0"'
                   1235:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1236:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1237:               .' /></a>';
                   1238:     if ($text ne "") {	
                   1239:         $template.='</span>';
                   1240:     }
1.44      bowersj2 1241:     return $template;
                   1242: 
1.106     bowersj2 1243: }
                   1244: 
                   1245: # This is a quicky function for Latex cheatsheet editing, since it 
                   1246: # appears in at least four places
                   1247: sub helpLatexCheatsheet {
1.1037    www      1248:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1249:     my $out;
1.106     bowersj2 1250:     my $addOther = '';
1.732     raeburn  1251:     if ($topic) {
1.1037    www      1252: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1253:     }
                   1254:     $out = '<span>' # Start cheatsheet
                   1255: 	  .$addOther
                   1256:           .'<span>'
1.1037    www      1257: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1258: 	  .'</span> <span>'
1.1037    www      1259: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1260: 	  .'</span>';
1.732     raeburn  1261:     unless ($not_author) {
1.763     bisitz   1262:         $out .= ' <span>'
1.1037    www      1263: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1264: 	       .'</span>';
1.732     raeburn  1265:     }
1.763     bisitz   1266:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1267:     return $out;
1.172     www      1268: }
                   1269: 
1.430     albertel 1270: sub general_help {
                   1271:     my $helptopic='Student_Intro';
                   1272:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1273: 	$helptopic='Authoring_Intro';
1.907     raeburn  1274:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1275: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1276:     } elsif ($env{'request.role'}=~/^dc/) {
                   1277:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1278:     }
                   1279:     return $helptopic;
                   1280: }
                   1281: 
                   1282: sub update_help_link {
                   1283:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1284:     my $origurl = $ENV{'REQUEST_URI'};
                   1285:     $origurl=~s|^/~|/priv/|;
                   1286:     my $timestamp = time;
                   1287:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1288:         $$datum = &escape($$datum);
                   1289:     }
                   1290: 
                   1291:     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";
                   1292:     my $output .= <<"ENDOUTPUT";
                   1293: <script type="text/javascript">
1.824     bisitz   1294: // <![CDATA[
1.430     albertel 1295: banner_link = '$banner_link';
1.824     bisitz   1296: // ]]>
1.430     albertel 1297: </script>
                   1298: ENDOUTPUT
                   1299:     return $output;
                   1300: }
                   1301: 
                   1302: # now just updates the help link and generates a blue icon
1.193     raeburn  1303: sub help_open_menu {
1.430     albertel 1304:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1305: 	= @_;    
1.949     droeschl 1306:     $stayOnPage = 1;
1.430     albertel 1307:     my $output;
                   1308:     if ($component_help) {
                   1309: 	if (!$text) {
                   1310: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1311: 				       $width,$height);
                   1312: 	} else {
                   1313: 	    my $help_text;
                   1314: 	    $help_text=&unescape($topic);
                   1315: 	    $output='<table><tr><td>'.
                   1316: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1317: 				 $width,$height).'</td></tr></table>';
                   1318: 	}
                   1319:     }
                   1320:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1321:     return $output.$banner_link;
                   1322: }
                   1323: 
                   1324: sub top_nav_help {
                   1325:     my ($text) = @_;
1.436     albertel 1326:     $text = &mt($text);
1.949     droeschl 1327:     my $stay_on_page = 1;
                   1328: 
1.572     banghart 1329:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1330: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1331:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1332: 
1.201     raeburn  1333:     my $title = &mt('Get help');
1.436     albertel 1334: 
                   1335:     return <<"END";
                   1336: $banner_link
                   1337:  <a href="$link" title="$title">$text</a>
                   1338: END
                   1339: }
                   1340: 
                   1341: sub help_menu_js {
                   1342:     my ($text) = @_;
1.949     droeschl 1343:     my $stayOnPage = 1;
1.436     albertel 1344:     my $width = 620;
                   1345:     my $height = 600;
1.430     albertel 1346:     my $helptopic=&general_help();
                   1347:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1348:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1349:     my $start_page =
                   1350:         &Apache::loncommon::start_page('Help Menu', undef,
                   1351: 				       {'frameset'    => 1,
                   1352: 					'js_ready'    => 1,
                   1353: 					'add_entries' => {
                   1354: 					    'border' => '0',
1.579     raeburn  1355: 					    'rows'   => "110,*",},});
1.331     albertel 1356:     my $end_page =
                   1357:         &Apache::loncommon::end_page({'frameset' => 1,
                   1358: 				      'js_ready' => 1,});
                   1359: 
1.436     albertel 1360:     my $template .= <<"ENDTEMPLATE";
                   1361: <script type="text/javascript">
1.877     bisitz   1362: // <![CDATA[
1.253     albertel 1363: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1364: var banner_link = '';
1.243     raeburn  1365: function helpMenu(target) {
                   1366:     var caller = this;
                   1367:     if (target == 'open') {
                   1368:         var newWindow = null;
                   1369:         try {
1.262     albertel 1370:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1371:         }
                   1372:         catch(error) {
                   1373:             writeHelp(caller);
                   1374:             return;
                   1375:         }
                   1376:         if (newWindow) {
                   1377:             caller = newWindow;
                   1378:         }
1.193     raeburn  1379:     }
1.243     raeburn  1380:     writeHelp(caller);
                   1381:     return;
                   1382: }
                   1383: function writeHelp(caller) {
1.1072    raeburn  1384:     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  1385:     caller.document.close()
                   1386:     caller.focus()
1.193     raeburn  1387: }
1.877     bisitz   1388: // END LON-CAPA Internal -->
1.253     albertel 1389: // ]]>
1.436     albertel 1390: </script>
1.193     raeburn  1391: ENDTEMPLATE
                   1392:     return $template;
                   1393: }
                   1394: 
1.172     www      1395: sub help_open_bug {
                   1396:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1397:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1398:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1399:     $text = "" if (not defined $text);
                   1400: 	$stayOnPage=1;
1.184     albertel 1401:     $width = 600 if (not defined $width);
                   1402:     $height = 600 if (not defined $height);
1.172     www      1403: 
                   1404:     $topic=~s/\W+/\+/g;
                   1405:     my $link='';
                   1406:     my $template='';
1.379     albertel 1407:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1408: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1409:     if (!$stayOnPage)
                   1410:     {
                   1411: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1412:     }
                   1413:     else
                   1414:     {
                   1415: 	$link = $url;
                   1416:     }
                   1417:     # Add the text
                   1418:     if ($text ne "")
                   1419:     {
                   1420: 	$template .= 
                   1421:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1422:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1423:     }
                   1424: 
                   1425:     # Add the graphic
1.179     matthew  1426:     my $title = &mt('Report a Bug');
1.215     albertel 1427:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1428:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1429:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1430: ENDTEMPLATE
                   1431:     if ($text ne '') { $template.='</td></tr></table>' };
                   1432:     return $template;
                   1433: 
                   1434: }
                   1435: 
                   1436: sub help_open_faq {
                   1437:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1438:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1439:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1440:     $text = "" if (not defined $text);
                   1441: 	$stayOnPage=1;
                   1442:     $width = 350 if (not defined $width);
                   1443:     $height = 400 if (not defined $height);
                   1444: 
                   1445:     $topic=~s/\W+/\+/g;
                   1446:     my $link='';
                   1447:     my $template='';
                   1448:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1449:     if (!$stayOnPage)
                   1450:     {
                   1451: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1452:     }
                   1453:     else
                   1454:     {
                   1455: 	$link = $url;
                   1456:     }
                   1457: 
                   1458:     # Add the text
                   1459:     if ($text ne "")
                   1460:     {
                   1461: 	$template .= 
1.173     www      1462:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1463:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1464:     }
                   1465: 
                   1466:     # Add the graphic
1.179     matthew  1467:     my $title = &mt('View the FAQ');
1.215     albertel 1468:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1469:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1470:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1471: ENDTEMPLATE
                   1472:     if ($text ne '') { $template.='</td></tr></table>' };
                   1473:     return $template;
                   1474: 
1.44      bowersj2 1475: }
1.37      matthew  1476: 
1.180     matthew  1477: ###############################################################
                   1478: ###############################################################
                   1479: 
1.45      matthew  1480: =pod
                   1481: 
1.648     raeburn  1482: =item * &change_content_javascript():
1.256     matthew  1483: 
                   1484: This and the next function allow you to create small sections of an
                   1485: otherwise static HTML page that you can update on the fly with
                   1486: Javascript, even in Netscape 4.
                   1487: 
                   1488: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1489: must be written to the HTML page once. It will prove the Javascript
                   1490: function "change(name, content)". Calling the change function with the
                   1491: name of the section 
                   1492: you want to update, matching the name passed to C<changable_area>, and
                   1493: the new content you want to put in there, will put the content into
                   1494: that area.
                   1495: 
                   1496: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1497: to contain room for the original contents. You need to "make space"
                   1498: for whatever changes you wish to make, and be B<sure> to check your
                   1499: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1500: it's adequate for updating a one-line status display, but little more.
                   1501: This script will set the space to 100% width, so you only need to
                   1502: worry about height in Netscape 4.
                   1503: 
                   1504: Modern browsers are much less limiting, and if you can commit to the
                   1505: user not using Netscape 4, this feature may be used freely with
                   1506: pretty much any HTML.
                   1507: 
                   1508: =cut
                   1509: 
                   1510: sub change_content_javascript {
                   1511:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1512:     if ($env{'browser.type'} eq 'netscape' &&
                   1513: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1514: 	return (<<NETSCAPE4);
                   1515: 	function change(name, content) {
                   1516: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1517: 	    doc.open();
                   1518: 	    doc.write(content);
                   1519: 	    doc.close();
                   1520: 	}
                   1521: NETSCAPE4
                   1522:     } else {
                   1523: 	# Otherwise, we need to use semi-standards-compliant code
                   1524: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1525: 	# is really scary, and every useful browser supports it
                   1526: 	return (<<DOMBASED);
                   1527: 	function change(name, content) {
                   1528: 	    element = document.getElementById(name);
                   1529: 	    element.innerHTML = content;
                   1530: 	}
                   1531: DOMBASED
                   1532:     }
                   1533: }
                   1534: 
                   1535: =pod
                   1536: 
1.648     raeburn  1537: =item * &changable_area($name,$origContent):
1.256     matthew  1538: 
                   1539: This provides a "changable area" that can be modified on the fly via
                   1540: the Javascript code provided in C<change_content_javascript>. $name is
                   1541: the name you will use to reference the area later; do not repeat the
                   1542: same name on a given HTML page more then once. $origContent is what
                   1543: the area will originally contain, which can be left blank.
                   1544: 
                   1545: =cut
                   1546: 
                   1547: sub changable_area {
                   1548:     my ($name, $origContent) = @_;
                   1549: 
1.258     albertel 1550:     if ($env{'browser.type'} eq 'netscape' &&
                   1551: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1552: 	# If this is netscape 4, we need to use the Layer tag
                   1553: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1554:     } else {
                   1555: 	return "<span id='$name'>$origContent</span>";
                   1556:     }
                   1557: }
                   1558: 
                   1559: =pod
                   1560: 
1.648     raeburn  1561: =item * &viewport_geometry_js 
1.590     raeburn  1562: 
                   1563: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1564: 
                   1565: =cut
                   1566: 
                   1567: 
                   1568: sub viewport_geometry_js { 
                   1569:     return <<"GEOMETRY";
                   1570: var Geometry = {};
                   1571: function init_geometry() {
                   1572:     if (Geometry.init) { return };
                   1573:     Geometry.init=1;
                   1574:     if (window.innerHeight) {
                   1575:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1576:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1577:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1578:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1579:     }
                   1580:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1581:         Geometry.getViewportHeight =
                   1582:             function() { return document.documentElement.clientHeight; };
                   1583:         Geometry.getViewportWidth =
                   1584:             function() { return document.documentElement.clientWidth; };
                   1585: 
                   1586:         Geometry.getHorizontalScroll =
                   1587:             function() { return document.documentElement.scrollLeft; };
                   1588:         Geometry.getVerticalScroll =
                   1589:             function() { return document.documentElement.scrollTop; };
                   1590:     }
                   1591:     else if (document.body.clientHeight) {
                   1592:         Geometry.getViewportHeight =
                   1593:             function() { return document.body.clientHeight; };
                   1594:         Geometry.getViewportWidth =
                   1595:             function() { return document.body.clientWidth; };
                   1596:         Geometry.getHorizontalScroll =
                   1597:             function() { return document.body.scrollLeft; };
                   1598:         Geometry.getVerticalScroll =
                   1599:             function() { return document.body.scrollTop; };
                   1600:     }
                   1601: }
                   1602: 
                   1603: GEOMETRY
                   1604: }
                   1605: 
                   1606: =pod
                   1607: 
1.648     raeburn  1608: =item * &viewport_size_js()
1.590     raeburn  1609: 
                   1610: 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. 
                   1611: 
                   1612: =cut
                   1613: 
                   1614: sub viewport_size_js {
                   1615:     my $geometry = &viewport_geometry_js();
                   1616:     return <<"DIMS";
                   1617: 
                   1618: $geometry
                   1619: 
                   1620: function getViewportDims(width,height) {
                   1621:     init_geometry();
                   1622:     width.value = Geometry.getViewportWidth();
                   1623:     height.value = Geometry.getViewportHeight();
                   1624:     return;
                   1625: }
                   1626: 
                   1627: DIMS
                   1628: }
                   1629: 
                   1630: =pod
                   1631: 
1.648     raeburn  1632: =item * &resize_textarea_js()
1.565     albertel 1633: 
                   1634: emits the needed javascript to resize a textarea to be as big as possible
                   1635: 
                   1636: creates a function resize_textrea that takes two IDs first should be
                   1637: the id of the element to resize, second should be the id of a div that
                   1638: surrounds everything that comes after the textarea, this routine needs
                   1639: to be attached to the <body> for the onload and onresize events.
                   1640: 
1.648     raeburn  1641: =back
1.565     albertel 1642: 
                   1643: =cut
                   1644: 
                   1645: sub resize_textarea_js {
1.590     raeburn  1646:     my $geometry = &viewport_geometry_js();
1.565     albertel 1647:     return <<"RESIZE";
                   1648:     <script type="text/javascript">
1.824     bisitz   1649: // <![CDATA[
1.590     raeburn  1650: $geometry
1.565     albertel 1651: 
1.588     albertel 1652: function getX(element) {
                   1653:     var x = 0;
                   1654:     while (element) {
                   1655: 	x += element.offsetLeft;
                   1656: 	element = element.offsetParent;
                   1657:     }
                   1658:     return x;
                   1659: }
                   1660: function getY(element) {
                   1661:     var y = 0;
                   1662:     while (element) {
                   1663: 	y += element.offsetTop;
                   1664: 	element = element.offsetParent;
                   1665:     }
                   1666:     return y;
                   1667: }
                   1668: 
                   1669: 
1.565     albertel 1670: function resize_textarea(textarea_id,bottom_id) {
                   1671:     init_geometry();
                   1672:     var textarea        = document.getElementById(textarea_id);
                   1673:     //alert(textarea);
                   1674: 
1.588     albertel 1675:     var textarea_top    = getY(textarea);
1.565     albertel 1676:     var textarea_height = textarea.offsetHeight;
                   1677:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1678:     var bottom_top      = getY(bottom);
1.565     albertel 1679:     var bottom_height   = bottom.offsetHeight;
                   1680:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1681:     var fudge           = 23;
1.565     albertel 1682:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1683:     if (new_height < 300) {
                   1684: 	new_height = 300;
                   1685:     }
                   1686:     textarea.style.height=new_height+'px';
                   1687: }
1.824     bisitz   1688: // ]]>
1.565     albertel 1689: </script>
                   1690: RESIZE
                   1691: 
                   1692: }
                   1693: 
                   1694: =pod
                   1695: 
1.256     matthew  1696: =head1 Excel and CSV file utility routines
                   1697: 
                   1698: =over 4
                   1699: 
                   1700: =cut
                   1701: 
                   1702: ###############################################################
                   1703: ###############################################################
                   1704: 
                   1705: =pod
                   1706: 
1.648     raeburn  1707: =item * &csv_translate($text) 
1.37      matthew  1708: 
1.185     www      1709: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1710: format.
                   1711: 
                   1712: =cut
                   1713: 
1.180     matthew  1714: ###############################################################
                   1715: ###############################################################
1.37      matthew  1716: sub csv_translate {
                   1717:     my $text = shift;
                   1718:     $text =~ s/\"/\"\"/g;
1.209     albertel 1719:     $text =~ s/\n/ /g;
1.37      matthew  1720:     return $text;
                   1721: }
1.180     matthew  1722: 
                   1723: ###############################################################
                   1724: ###############################################################
                   1725: 
                   1726: =pod
                   1727: 
1.648     raeburn  1728: =item * &define_excel_formats()
1.180     matthew  1729: 
                   1730: Define some commonly used Excel cell formats.
                   1731: 
                   1732: Currently supported formats:
                   1733: 
                   1734: =over 4
                   1735: 
                   1736: =item header
                   1737: 
                   1738: =item bold
                   1739: 
                   1740: =item h1
                   1741: 
                   1742: =item h2
                   1743: 
                   1744: =item h3
                   1745: 
1.256     matthew  1746: =item h4
                   1747: 
                   1748: =item i
                   1749: 
1.180     matthew  1750: =item date
                   1751: 
                   1752: =back
                   1753: 
                   1754: Inputs: $workbook
                   1755: 
                   1756: Returns: $format, a hash reference.
                   1757: 
1.1057    foxr     1758: 
1.180     matthew  1759: =cut
                   1760: 
                   1761: ###############################################################
                   1762: ###############################################################
                   1763: sub define_excel_formats {
                   1764:     my ($workbook) = @_;
                   1765:     my $format;
                   1766:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1767:                                                 bottom    => 1,
                   1768:                                                 align     => 'center');
                   1769:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1770:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1771:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1772:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1773:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1774:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1775:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1776:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1777:     return $format;
                   1778: }
                   1779: 
                   1780: ###############################################################
                   1781: ###############################################################
1.113     bowersj2 1782: 
                   1783: =pod
                   1784: 
1.648     raeburn  1785: =item * &create_workbook()
1.255     matthew  1786: 
                   1787: Create an Excel worksheet.  If it fails, output message on the
                   1788: request object and return undefs.
                   1789: 
                   1790: Inputs: Apache request object
                   1791: 
                   1792: Returns (undef) on failure, 
                   1793:     Excel worksheet object, scalar with filename, and formats 
                   1794:     from &Apache::loncommon::define_excel_formats on success
                   1795: 
                   1796: =cut
                   1797: 
                   1798: ###############################################################
                   1799: ###############################################################
                   1800: sub create_workbook {
                   1801:     my ($r) = @_;
                   1802:         #
                   1803:     # Create the excel spreadsheet
                   1804:     my $filename = '/prtspool/'.
1.258     albertel 1805:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1806:         time.'_'.rand(1000000000).'.xls';
                   1807:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1808:     if (! defined($workbook)) {
                   1809:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1810:         $r->print(
                   1811:             '<p class="LC_error">'
                   1812:            .&mt('Problems occurred in creating the new Excel file.')
                   1813:            .' '.&mt('This error has been logged.')
                   1814:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1815:            .'</p>'
                   1816:         );
1.255     matthew  1817:         return (undef);
                   1818:     }
                   1819:     #
1.1014    foxr     1820:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1821:     #
                   1822:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1823:     return ($workbook,$filename,$format);
                   1824: }
                   1825: 
                   1826: ###############################################################
                   1827: ###############################################################
                   1828: 
                   1829: =pod
                   1830: 
1.648     raeburn  1831: =item * &create_text_file()
1.113     bowersj2 1832: 
1.542     raeburn  1833: Create a file to write to and eventually make available to the user.
1.256     matthew  1834: If file creation fails, outputs an error message on the request object and 
                   1835: return undefs.
1.113     bowersj2 1836: 
1.256     matthew  1837: Inputs: Apache request object, and file suffix
1.113     bowersj2 1838: 
1.256     matthew  1839: Returns (undef) on failure, 
                   1840:     Filehandle and filename on success.
1.113     bowersj2 1841: 
                   1842: =cut
                   1843: 
1.256     matthew  1844: ###############################################################
                   1845: ###############################################################
                   1846: sub create_text_file {
                   1847:     my ($r,$suffix) = @_;
                   1848:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1849:     my $fh;
                   1850:     my $filename = '/prtspool/'.
1.258     albertel 1851:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1852:         time.'_'.rand(1000000000).'.'.$suffix;
                   1853:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1854:     if (! defined($fh)) {
                   1855:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1856:         $r->print(
                   1857:             '<p class="LC_error">'
                   1858:            .&mt('Problems occurred in creating the output file.')
                   1859:            .' '.&mt('This error has been logged.')
                   1860:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1861:            .'</p>'
                   1862:         );
1.113     bowersj2 1863:     }
1.256     matthew  1864:     return ($fh,$filename)
1.113     bowersj2 1865: }
                   1866: 
                   1867: 
1.256     matthew  1868: =pod 
1.113     bowersj2 1869: 
                   1870: =back
                   1871: 
                   1872: =cut
1.37      matthew  1873: 
                   1874: ###############################################################
1.33      matthew  1875: ##        Home server <option> list generating code          ##
                   1876: ###############################################################
1.35      matthew  1877: 
1.169     www      1878: # ------------------------------------------
                   1879: 
                   1880: sub domain_select {
                   1881:     my ($name,$value,$multiple)=@_;
                   1882:     my %domains=map { 
1.514     albertel 1883: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1884:     } &Apache::lonnet::all_domains();
1.169     www      1885:     if ($multiple) {
                   1886: 	$domains{''}=&mt('Any domain');
1.550     albertel 1887: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1888: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1889:     } else {
1.550     albertel 1890: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1891: 	return &select_form($name,$value,\%domains);
1.169     www      1892:     }
                   1893: }
                   1894: 
1.282     albertel 1895: #-------------------------------------------
                   1896: 
                   1897: =pod
                   1898: 
1.519     raeburn  1899: =head1 Routines for form select boxes
                   1900: 
                   1901: =over 4
                   1902: 
1.648     raeburn  1903: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1904: 
                   1905: Returns a string containing a <select> element int multiple mode
                   1906: 
                   1907: 
                   1908: Args:
                   1909:   $name - name of the <select> element
1.506     raeburn  1910:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1911:   $size - number of rows long the select element is
1.283     albertel 1912:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1913:           (shown text should already have been &mt())
1.506     raeburn  1914:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1915: 
1.282     albertel 1916: =cut
                   1917: 
                   1918: #-------------------------------------------
1.169     www      1919: sub multiple_select_form {
1.284     albertel 1920:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1921:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1922:     my $output='';
1.191     matthew  1923:     if (! defined($size)) {
                   1924:         $size = 4;
1.283     albertel 1925:         if (scalar(keys(%$hash))<4) {
                   1926:             $size = scalar(keys(%$hash));
1.191     matthew  1927:         }
                   1928:     }
1.734     bisitz   1929:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1930:     my @order;
1.506     raeburn  1931:     if (ref($order) eq 'ARRAY')  {
                   1932:         @order = @{$order};
                   1933:     } else {
                   1934:         @order = sort(keys(%$hash));
1.501     banghart 1935:     }
                   1936:     if (exists($$hash{'select_form_order'})) {
                   1937:         @order = @{$$hash{'select_form_order'}};
                   1938:     }
                   1939:         
1.284     albertel 1940:     foreach my $key (@order) {
1.356     albertel 1941:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1942:         $output.='selected="selected" ' if ($selected{$key});
                   1943:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1944:     }
                   1945:     $output.="</select>\n";
                   1946:     return $output;
                   1947: }
                   1948: 
1.88      www      1949: #-------------------------------------------
                   1950: 
                   1951: =pod
                   1952: 
1.970     raeburn  1953: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1954: 
                   1955: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1956: allow a user to select options from a ref to a hash containing:
                   1957: option_name => displayed text. An optional $onchange can include
                   1958: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1959: 
1.88      www      1960: See lonrights.pm for an example invocation and use.
                   1961: 
                   1962: =cut
                   1963: 
                   1964: #-------------------------------------------
                   1965: sub select_form {
1.970     raeburn  1966:     my ($def,$name,$hashref,$onchange) = @_;
                   1967:     return unless (ref($hashref) eq 'HASH');
                   1968:     if ($onchange) {
                   1969:         $onchange = ' onchange="'.$onchange.'"';
                   1970:     }
                   1971:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1972:     my @keys;
1.970     raeburn  1973:     if (exists($hashref->{'select_form_order'})) {
                   1974: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1975:     } else {
1.970     raeburn  1976: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1977:     }
1.356     albertel 1978:     foreach my $key (@keys) {
                   1979:         $selectform.=
                   1980: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1981:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1982:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1983:     }
                   1984:     $selectform.="</select>";
                   1985:     return $selectform;
                   1986: }
                   1987: 
1.475     www      1988: # For display filters
                   1989: 
                   1990: sub display_filter {
1.1074    raeburn  1991:     my ($context) = @_;
1.475     www      1992:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1993:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  1994:     my $phraseinput = 'hidden';
                   1995:     my $includeinput = 'hidden';
                   1996:     my ($checked,$includetypestext);
                   1997:     if ($env{'form.displayfilter'} eq 'containing') {
                   1998:         $phraseinput = 'text'; 
                   1999:         if ($context eq 'parmslog') {
                   2000:             $includeinput = 'checkbox';
                   2001:             if ($env{'form.includetypes'}) {
                   2002:                 $checked = ' checked="checked"';
                   2003:             }
                   2004:             $includetypestext = &mt('Include parameter types');
                   2005:         }
                   2006:     } else {
                   2007:         $includetypestext = '&nbsp;';
                   2008:     }
                   2009:     my ($additional,$secondid,$thirdid);
                   2010:     if ($context eq 'parmslog') {
                   2011:         $additional = 
                   2012:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2013:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2014:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2015:             '</label>';
                   2016:         $secondid = 'includetypes';
                   2017:         $thirdid = 'includetypestext';
                   2018:     }
                   2019:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2020:                                                     '$secondid','$thirdid')";
                   2021:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2022: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2023: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2024: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2025:            &mt('Filter: [_1]',
1.477     www      2026: 	   &select_form($env{'form.displayfilter'},
                   2027: 			'displayfilter',
1.970     raeburn  2028: 			{'currentfolder' => 'Current folder/page',
1.477     www      2029: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2030: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2031: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2032:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2033:                          '" />'.$additional;
                   2034: }
                   2035: 
                   2036: sub display_filter_js {
                   2037:     my $includetext = &mt('Include parameter types');
                   2038:     return <<"ENDJS";
                   2039:   
                   2040: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2041:     var firstType = 'hidden';
                   2042:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2043:         firstType = 'text';
                   2044:     }
                   2045:     firstObject = document.getElementById(firstid);
                   2046:     if (typeof(firstObject) == 'object') {
                   2047:         if (firstObject.type != firstType) {
                   2048:             changeInputType(firstObject,firstType);
                   2049:         }
                   2050:     }
                   2051:     if (context == 'parmslog') {
                   2052:         var secondType = 'hidden';
                   2053:         if (firstType == 'text') {
                   2054:             secondType = 'checkbox';
                   2055:         }
                   2056:         secondObject = document.getElementById(secondid);  
                   2057:         if (typeof(secondObject) == 'object') {
                   2058:             if (secondObject.type != secondType) {
                   2059:                 changeInputType(secondObject,secondType);
                   2060:             }
                   2061:         }
                   2062:         var textItem = document.getElementById(thirdid);
                   2063:         var currtext = textItem.innerHTML;
                   2064:         var newtext;
                   2065:         if (firstType == 'text') {
                   2066:             newtext = '$includetext';
                   2067:         } else {
                   2068:             newtext = '&nbsp;';
                   2069:         }
                   2070:         if (currtext != newtext) {
                   2071:             textItem.innerHTML = newtext;
                   2072:         }
                   2073:     }
                   2074:     return;
                   2075: }
                   2076: 
                   2077: function changeInputType(oldObject,newType) {
                   2078:     var newObject = document.createElement('input');
                   2079:     newObject.type = newType;
                   2080:     if (oldObject.size) {
                   2081:         newObject.size = oldObject.size;
                   2082:     }
                   2083:     if (oldObject.value) {
                   2084:         newObject.value = oldObject.value;
                   2085:     }
                   2086:     if (oldObject.name) {
                   2087:         newObject.name = oldObject.name;
                   2088:     }
                   2089:     if (oldObject.id) {
                   2090:         newObject.id = oldObject.id;
                   2091:     }
                   2092:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2093:     return;
                   2094: }
                   2095: 
                   2096: ENDJS
1.475     www      2097: }
                   2098: 
1.167     www      2099: sub gradeleveldescription {
                   2100:     my $gradelevel=shift;
                   2101:     my %gradelevels=(0 => 'Not specified',
                   2102: 		     1 => 'Grade 1',
                   2103: 		     2 => 'Grade 2',
                   2104: 		     3 => 'Grade 3',
                   2105: 		     4 => 'Grade 4',
                   2106: 		     5 => 'Grade 5',
                   2107: 		     6 => 'Grade 6',
                   2108: 		     7 => 'Grade 7',
                   2109: 		     8 => 'Grade 8',
                   2110: 		     9 => 'Grade 9',
                   2111: 		     10 => 'Grade 10',
                   2112: 		     11 => 'Grade 11',
                   2113: 		     12 => 'Grade 12',
                   2114: 		     13 => 'Grade 13',
                   2115: 		     14 => '100 Level',
                   2116: 		     15 => '200 Level',
                   2117: 		     16 => '300 Level',
                   2118: 		     17 => '400 Level',
                   2119: 		     18 => 'Graduate Level');
                   2120:     return &mt($gradelevels{$gradelevel});
                   2121: }
                   2122: 
1.163     www      2123: sub select_level_form {
                   2124:     my ($deflevel,$name)=@_;
                   2125:     unless ($deflevel) { $deflevel=0; }
1.167     www      2126:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2127:     for (my $i=0; $i<=18; $i++) {
                   2128:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2129:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2130:                 ">".&gradeleveldescription($i)."</option>\n";
                   2131:     }
                   2132:     $selectform.="</select>";
                   2133:     return $selectform;
1.163     www      2134: }
1.167     www      2135: 
1.35      matthew  2136: #-------------------------------------------
                   2137: 
1.45      matthew  2138: =pod
                   2139: 
1.910     raeburn  2140: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  2141: 
                   2142: Returns a string containing a <select name='$name' size='1'> form to 
                   2143: allow a user to select the domain to preform an operation in.  
                   2144: See loncreateuser.pm for an example invocation and use.
                   2145: 
1.90      www      2146: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2147: selected");
                   2148: 
1.743     raeburn  2149: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2150: 
1.910     raeburn  2151: 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.
                   2152: 
                   2153: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  2154: 
1.35      matthew  2155: =cut
                   2156: 
                   2157: #-------------------------------------------
1.34      matthew  2158: sub select_dom_form {
1.910     raeburn  2159:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  2160:     if ($onchange) {
1.874     raeburn  2161:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2162:     }
1.910     raeburn  2163:     my @domains;
                   2164:     if (ref($incdoms) eq 'ARRAY') {
                   2165:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2166:     } else {
                   2167:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2168:     }
1.90      www      2169:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  2170:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2171:     foreach my $dom (@domains) {
                   2172:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2173:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2174:         if ($showdomdesc) {
                   2175:             if ($dom ne '') {
                   2176:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2177:                 if ($domdesc ne '') {
                   2178:                     $selectdomain .= ' ('.$domdesc.')';
                   2179:                 }
                   2180:             } 
                   2181:         }
                   2182:         $selectdomain .= "</option>\n";
1.34      matthew  2183:     }
                   2184:     $selectdomain.="</select>";
                   2185:     return $selectdomain;
                   2186: }
                   2187: 
1.35      matthew  2188: #-------------------------------------------
                   2189: 
1.45      matthew  2190: =pod
                   2191: 
1.648     raeburn  2192: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2193: 
1.586     raeburn  2194: input: 4 arguments (two required, two optional) - 
                   2195:     $domain - domain of new user
                   2196:     $name - name of form element
                   2197:     $default - Value of 'default' causes a default item to be first 
                   2198:                             option, and selected by default. 
                   2199:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2200:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2201: output: returns 2 items: 
1.586     raeburn  2202: (a) form element which contains either:
                   2203:    (i) <select name="$name">
                   2204:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2205:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2206:        </select>
                   2207:        form item if there are multiple library servers in $domain, or
                   2208:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2209:        if there is only one library server in $domain.
                   2210: 
                   2211: (b) number of library servers found.
                   2212: 
                   2213: See loncreateuser.pm for example of use.
1.35      matthew  2214: 
                   2215: =cut
                   2216: 
                   2217: #-------------------------------------------
1.586     raeburn  2218: sub home_server_form_item {
                   2219:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2220:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2221:     my $result;
                   2222:     my $numlib = keys(%servers);
                   2223:     if ($numlib > 1) {
                   2224:         $result .= '<select name="'.$name.'" />'."\n";
                   2225:         if ($default) {
1.804     bisitz   2226:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2227:                        '</option>'."\n";
                   2228:         }
                   2229:         foreach my $hostid (sort(keys(%servers))) {
                   2230:             $result.= '<option value="'.$hostid.'">'.
                   2231: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2232:         }
                   2233:         $result .= '</select>'."\n";
                   2234:     } elsif ($numlib == 1) {
                   2235:         my $hostid;
                   2236:         foreach my $item (keys(%servers)) {
                   2237:             $hostid = $item;
                   2238:         }
                   2239:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2240:                    $hostid.'" />';
                   2241:                    if (!$hide) {
                   2242:                        $result .= $hostid.' '.$servers{$hostid};
                   2243:                    }
                   2244:                    $result .= "\n";
                   2245:     } elsif ($default) {
                   2246:         $result .= '<input type="hidden" name="'.$name.
                   2247:                    '" value="default" />';
                   2248:                    if (!$hide) {
                   2249:                        $result .= &mt('default');
                   2250:                    }
                   2251:                    $result .= "\n";
1.33      matthew  2252:     }
1.586     raeburn  2253:     return ($result,$numlib);
1.33      matthew  2254: }
1.112     bowersj2 2255: 
                   2256: =pod
                   2257: 
1.534     albertel 2258: =back 
                   2259: 
1.112     bowersj2 2260: =cut
1.87      matthew  2261: 
                   2262: ###############################################################
1.112     bowersj2 2263: ##                  Decoding User Agent                      ##
1.87      matthew  2264: ###############################################################
                   2265: 
                   2266: =pod
                   2267: 
1.112     bowersj2 2268: =head1 Decoding the User Agent
                   2269: 
                   2270: =over 4
                   2271: 
                   2272: =item * &decode_user_agent()
1.87      matthew  2273: 
                   2274: Inputs: $r
                   2275: 
                   2276: Outputs:
                   2277: 
                   2278: =over 4
                   2279: 
1.112     bowersj2 2280: =item * $httpbrowser
1.87      matthew  2281: 
1.112     bowersj2 2282: =item * $clientbrowser
1.87      matthew  2283: 
1.112     bowersj2 2284: =item * $clientversion
1.87      matthew  2285: 
1.112     bowersj2 2286: =item * $clientmathml
1.87      matthew  2287: 
1.112     bowersj2 2288: =item * $clientunicode
1.87      matthew  2289: 
1.112     bowersj2 2290: =item * $clientos
1.87      matthew  2291: 
                   2292: =back
                   2293: 
1.157     matthew  2294: =back 
                   2295: 
1.87      matthew  2296: =cut
                   2297: 
                   2298: ###############################################################
                   2299: ###############################################################
                   2300: sub decode_user_agent {
1.247     albertel 2301:     my ($r)=@_;
1.87      matthew  2302:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2303:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2304:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2305:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2306:     my $clientbrowser='unknown';
                   2307:     my $clientversion='0';
                   2308:     my $clientmathml='';
                   2309:     my $clientunicode='0';
                   2310:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2311:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2312: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2313: 	    $clientbrowser=$bname;
                   2314:             $httpbrowser=~/$vreg/i;
                   2315: 	    $clientversion=$1;
                   2316:             $clientmathml=($clientversion>=$minv);
                   2317:             $clientunicode=($clientversion>=$univ);
                   2318: 	}
                   2319:     }
                   2320:     my $clientos='unknown';
                   2321:     if (($httpbrowser=~/linux/i) ||
                   2322:         ($httpbrowser=~/unix/i) ||
                   2323:         ($httpbrowser=~/ux/i) ||
                   2324:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2325:     if (($httpbrowser=~/vax/i) ||
                   2326:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2327:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2328:     if (($httpbrowser=~/mac/i) ||
                   2329:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2330:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2331:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2332:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2333:             $clientunicode,$clientos,);
                   2334: }
                   2335: 
1.32      matthew  2336: ###############################################################
                   2337: ##    Authentication changing form generation subroutines    ##
                   2338: ###############################################################
                   2339: ##
                   2340: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2341: ## hash, and have reasonable default values.
                   2342: ##
                   2343: ##    formname = the name given in the <form> tag.
1.35      matthew  2344: #-------------------------------------------
                   2345: 
1.45      matthew  2346: =pod
                   2347: 
1.112     bowersj2 2348: =head1 Authentication Routines
                   2349: 
                   2350: =over 4
                   2351: 
1.648     raeburn  2352: =item * &authform_xxxxxx()
1.35      matthew  2353: 
                   2354: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2355: handle some of the conveniences required for authentication forms.  
                   2356: This is not an optimal method, but it works.  
                   2357: 
                   2358: =over 4
                   2359: 
1.112     bowersj2 2360: =item * authform_header
1.35      matthew  2361: 
1.112     bowersj2 2362: =item * authform_authorwarning
1.35      matthew  2363: 
1.112     bowersj2 2364: =item * authform_nochange
1.35      matthew  2365: 
1.112     bowersj2 2366: =item * authform_kerberos
1.35      matthew  2367: 
1.112     bowersj2 2368: =item * authform_internal
1.35      matthew  2369: 
1.112     bowersj2 2370: =item * authform_filesystem
1.35      matthew  2371: 
                   2372: =back
                   2373: 
1.648     raeburn  2374: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2375: 
1.35      matthew  2376: =cut
                   2377: 
                   2378: #-------------------------------------------
1.32      matthew  2379: sub authform_header{  
                   2380:     my %in = (
                   2381:         formname => 'cu',
1.80      albertel 2382:         kerb_def_dom => '',
1.32      matthew  2383:         @_,
                   2384:     );
                   2385:     $in{'formname'} = 'document.' . $in{'formname'};
                   2386:     my $result='';
1.80      albertel 2387: 
                   2388: #---------------------------------------------- Code for upper case translation
                   2389:     my $Javascript_toUpperCase;
                   2390:     unless ($in{kerb_def_dom}) {
                   2391:         $Javascript_toUpperCase =<<"END";
                   2392:         switch (choice) {
                   2393:            case 'krb': currentform.elements[choicearg].value =
                   2394:                currentform.elements[choicearg].value.toUpperCase();
                   2395:                break;
                   2396:            default:
                   2397:         }
                   2398: END
                   2399:     } else {
                   2400:         $Javascript_toUpperCase = "";
                   2401:     }
                   2402: 
1.165     raeburn  2403:     my $radioval = "'nochange'";
1.591     raeburn  2404:     if (defined($in{'curr_authtype'})) {
                   2405:         if ($in{'curr_authtype'} ne '') {
                   2406:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2407:         }
1.174     matthew  2408:     }
1.165     raeburn  2409:     my $argfield = 'null';
1.591     raeburn  2410:     if (defined($in{'mode'})) {
1.165     raeburn  2411:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2412:             if (defined($in{'curr_autharg'})) {
                   2413:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2414:                     $argfield = "'$in{'curr_autharg'}'";
                   2415:                 }
                   2416:             }
                   2417:         }
                   2418:     }
                   2419: 
1.32      matthew  2420:     $result.=<<"END";
                   2421: var current = new Object();
1.165     raeburn  2422: current.radiovalue = $radioval;
                   2423: current.argfield = $argfield;
1.32      matthew  2424: 
                   2425: function changed_radio(choice,currentform) {
                   2426:     var choicearg = choice + 'arg';
                   2427:     // If a radio button in changed, we need to change the argfield
                   2428:     if (current.radiovalue != choice) {
                   2429:         current.radiovalue = choice;
                   2430:         if (current.argfield != null) {
                   2431:             currentform.elements[current.argfield].value = '';
                   2432:         }
                   2433:         if (choice == 'nochange') {
                   2434:             current.argfield = null;
                   2435:         } else {
                   2436:             current.argfield = choicearg;
                   2437:             switch(choice) {
                   2438:                 case 'krb': 
                   2439:                     currentform.elements[current.argfield].value = 
                   2440:                         "$in{'kerb_def_dom'}";
                   2441:                 break;
                   2442:               default:
                   2443:                 break;
                   2444:             }
                   2445:         }
                   2446:     }
                   2447:     return;
                   2448: }
1.22      www      2449: 
1.32      matthew  2450: function changed_text(choice,currentform) {
                   2451:     var choicearg = choice + 'arg';
                   2452:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2453:         $Javascript_toUpperCase
1.32      matthew  2454:         // clear old field
                   2455:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2456:             currentform.elements[current.argfield].value = '';
                   2457:         }
                   2458:         current.argfield = choicearg;
                   2459:     }
                   2460:     set_auth_radio_buttons(choice,currentform);
                   2461:     return;
1.20      www      2462: }
1.32      matthew  2463: 
                   2464: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2465:     var numauthchoices = currentform.login.length;
                   2466:     if (typeof numauthchoices  == "undefined") {
                   2467:         return;
                   2468:     } 
1.32      matthew  2469:     var i=0;
1.986     raeburn  2470:     while (i < numauthchoices) {
1.32      matthew  2471:         if (currentform.login[i].value == newvalue) { break; }
                   2472:         i++;
                   2473:     }
1.986     raeburn  2474:     if (i == numauthchoices) {
1.32      matthew  2475:         return;
                   2476:     }
                   2477:     current.radiovalue = newvalue;
                   2478:     currentform.login[i].checked = true;
                   2479:     return;
                   2480: }
                   2481: END
                   2482:     return $result;
                   2483: }
                   2484: 
1.1075.2.20  raeburn  2485: sub authform_authorwarning {
1.32      matthew  2486:     my $result='';
1.144     matthew  2487:     $result='<i>'.
                   2488:         &mt('As a general rule, only authors or co-authors should be '.
                   2489:             'filesystem authenticated '.
                   2490:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2491:     return $result;
                   2492: }
                   2493: 
1.1075.2.20  raeburn  2494: sub authform_nochange {
1.32      matthew  2495:     my %in = (
                   2496:               formname => 'document.cu',
                   2497:               kerb_def_dom => 'MSU.EDU',
                   2498:               @_,
                   2499:           );
1.1075.2.20  raeburn  2500:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2501:     my $result;
1.1075.2.20  raeburn  2502:     if (!$authnum) {
                   2503:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2504:     } else {
                   2505:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2506:                   '<input type="radio" name="login" value="nochange" '.
                   2507:                   'checked="checked" onclick="'.
1.281     albertel 2508:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2509: 	    '</label>';
1.586     raeburn  2510:     }
1.32      matthew  2511:     return $result;
                   2512: }
                   2513: 
1.591     raeburn  2514: sub authform_kerberos {
1.32      matthew  2515:     my %in = (
                   2516:               formname => 'document.cu',
                   2517:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2518:               kerb_def_auth => 'krb4',
1.32      matthew  2519:               @_,
                   2520:               );
1.586     raeburn  2521:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2522:         $autharg,$jscall);
1.1075.2.20  raeburn  2523:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2524:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2525:        $check5 = ' checked="checked"';
1.80      albertel 2526:     } else {
1.772     bisitz   2527:        $check4 = ' checked="checked"';
1.80      albertel 2528:     }
1.165     raeburn  2529:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2530:     if (defined($in{'curr_authtype'})) {
                   2531:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2532:             $krbcheck = ' checked="checked"';
1.623     raeburn  2533:             if (defined($in{'mode'})) {
                   2534:                 if ($in{'mode'} eq 'modifyuser') {
                   2535:                     $krbcheck = '';
                   2536:                 }
                   2537:             }
1.591     raeburn  2538:             if (defined($in{'curr_kerb_ver'})) {
                   2539:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2540:                     $check5 = ' checked="checked"';
1.591     raeburn  2541:                     $check4 = '';
                   2542:                 } else {
1.772     bisitz   2543:                     $check4 = ' checked="checked"';
1.591     raeburn  2544:                     $check5 = '';
                   2545:                 }
1.586     raeburn  2546:             }
1.591     raeburn  2547:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2548:                 $krbarg = $in{'curr_autharg'};
                   2549:             }
1.586     raeburn  2550:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2551:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2552:                     $result = 
                   2553:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2554:         $in{'curr_autharg'},$krbver);
                   2555:                 } else {
                   2556:                     $result =
                   2557:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2558:                 }
                   2559:                 return $result; 
                   2560:             }
                   2561:         }
                   2562:     } else {
                   2563:         if ($authnum == 1) {
1.784     bisitz   2564:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2565:         }
                   2566:     }
1.586     raeburn  2567:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2568:         return;
1.587     raeburn  2569:     } elsif ($authtype eq '') {
1.591     raeburn  2570:         if (defined($in{'mode'})) {
1.587     raeburn  2571:             if ($in{'mode'} eq 'modifycourse') {
                   2572:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2573:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2574:                 }
                   2575:             }
                   2576:         }
1.586     raeburn  2577:     }
                   2578:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2579:     if ($authtype eq '') {
                   2580:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2581:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2582:                     $krbcheck.' />';
                   2583:     }
                   2584:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2585:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2586:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2587:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2588:          $in{'curr_authtype'} eq 'krb4')) {
                   2589:         $result .= &mt
1.144     matthew  2590:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2591:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2592:          '<label>'.$authtype,
1.281     albertel 2593:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2594:              'value="'.$krbarg.'" '.
1.144     matthew  2595:              'onchange="'.$jscall.'" />',
1.281     albertel 2596:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2597:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2598: 	 '</label>');
1.586     raeburn  2599:     } elsif ($can_assign{'krb4'}) {
                   2600:         $result .= &mt
                   2601:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2602:          '[_3] Version 4 [_4]',
                   2603:          '<label>'.$authtype,
                   2604:          '</label><input type="text" size="10" name="krbarg" '.
                   2605:              'value="'.$krbarg.'" '.
                   2606:              'onchange="'.$jscall.'" />',
                   2607:          '<label><input type="hidden" name="krbver" value="4" />',
                   2608:          '</label>');
                   2609:     } elsif ($can_assign{'krb5'}) {
                   2610:         $result .= &mt
                   2611:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2612:          '[_3] Version 5 [_4]',
                   2613:          '<label>'.$authtype,
                   2614:          '</label><input type="text" size="10" name="krbarg" '.
                   2615:              'value="'.$krbarg.'" '.
                   2616:              'onchange="'.$jscall.'" />',
                   2617:          '<label><input type="hidden" name="krbver" value="5" />',
                   2618:          '</label>');
                   2619:     }
1.32      matthew  2620:     return $result;
                   2621: }
                   2622: 
1.1075.2.20  raeburn  2623: sub authform_internal {
1.586     raeburn  2624:     my %in = (
1.32      matthew  2625:                 formname => 'document.cu',
                   2626:                 kerb_def_dom => 'MSU.EDU',
                   2627:                 @_,
                   2628:                 );
1.586     raeburn  2629:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2630:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2631:     if (defined($in{'curr_authtype'})) {
                   2632:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2633:             if ($can_assign{'int'}) {
1.772     bisitz   2634:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2635:                 if (defined($in{'mode'})) {
                   2636:                     if ($in{'mode'} eq 'modifyuser') {
                   2637:                         $intcheck = '';
                   2638:                     }
                   2639:                 }
1.591     raeburn  2640:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2641:                     $intarg = $in{'curr_autharg'};
                   2642:                 }
                   2643:             } else {
                   2644:                 $result = &mt('Currently internally authenticated.');
                   2645:                 return $result;
1.165     raeburn  2646:             }
                   2647:         }
1.586     raeburn  2648:     } else {
                   2649:         if ($authnum == 1) {
1.784     bisitz   2650:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2651:         }
                   2652:     }
                   2653:     if (!$can_assign{'int'}) {
                   2654:         return;
1.587     raeburn  2655:     } elsif ($authtype eq '') {
1.591     raeburn  2656:         if (defined($in{'mode'})) {
1.587     raeburn  2657:             if ($in{'mode'} eq 'modifycourse') {
                   2658:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2659:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2660:                 }
                   2661:             }
                   2662:         }
1.165     raeburn  2663:     }
1.586     raeburn  2664:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2665:     if ($authtype eq '') {
                   2666:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2667:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2668:     }
1.605     bisitz   2669:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2670:                $intarg.'" onchange="'.$jscall.'" />';
                   2671:     $result = &mt
1.144     matthew  2672:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2673:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2674:     $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  2675:     return $result;
                   2676: }
                   2677: 
1.1075.2.20  raeburn  2678: sub authform_local {
1.32      matthew  2679:     my %in = (
                   2680:               formname => 'document.cu',
                   2681:               kerb_def_dom => 'MSU.EDU',
                   2682:               @_,
                   2683:               );
1.586     raeburn  2684:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2685:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2686:     if (defined($in{'curr_authtype'})) {
                   2687:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2688:             if ($can_assign{'loc'}) {
1.772     bisitz   2689:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2690:                 if (defined($in{'mode'})) {
                   2691:                     if ($in{'mode'} eq 'modifyuser') {
                   2692:                         $loccheck = '';
                   2693:                     }
                   2694:                 }
1.591     raeburn  2695:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2696:                     $locarg = $in{'curr_autharg'};
                   2697:                 }
                   2698:             } else {
                   2699:                 $result = &mt('Currently using local (institutional) authentication.');
                   2700:                 return $result;
1.165     raeburn  2701:             }
                   2702:         }
1.586     raeburn  2703:     } else {
                   2704:         if ($authnum == 1) {
1.784     bisitz   2705:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2706:         }
                   2707:     }
                   2708:     if (!$can_assign{'loc'}) {
                   2709:         return;
1.587     raeburn  2710:     } elsif ($authtype eq '') {
1.591     raeburn  2711:         if (defined($in{'mode'})) {
1.587     raeburn  2712:             if ($in{'mode'} eq 'modifycourse') {
                   2713:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2714:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2715:                 }
                   2716:             }
                   2717:         }
1.165     raeburn  2718:     }
1.586     raeburn  2719:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2720:     if ($authtype eq '') {
                   2721:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2722:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2723:                     $jscall.'" />';
                   2724:     }
                   2725:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2726:                $locarg.'" onchange="'.$jscall.'" />';
                   2727:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2728:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2729:     return $result;
                   2730: }
                   2731: 
1.1075.2.20  raeburn  2732: sub authform_filesystem {
1.32      matthew  2733:     my %in = (
                   2734:               formname => 'document.cu',
                   2735:               kerb_def_dom => 'MSU.EDU',
                   2736:               @_,
                   2737:               );
1.586     raeburn  2738:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2739:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2740:     if (defined($in{'curr_authtype'})) {
                   2741:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2742:             if ($can_assign{'fsys'}) {
1.772     bisitz   2743:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2744:                 if (defined($in{'mode'})) {
                   2745:                     if ($in{'mode'} eq 'modifyuser') {
                   2746:                         $fsyscheck = '';
                   2747:                     }
                   2748:                 }
1.586     raeburn  2749:             } else {
                   2750:                 $result = &mt('Currently Filesystem Authenticated.');
                   2751:                 return $result;
                   2752:             }           
                   2753:         }
                   2754:     } else {
                   2755:         if ($authnum == 1) {
1.784     bisitz   2756:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2757:         }
                   2758:     }
                   2759:     if (!$can_assign{'fsys'}) {
                   2760:         return;
1.587     raeburn  2761:     } elsif ($authtype eq '') {
1.591     raeburn  2762:         if (defined($in{'mode'})) {
1.587     raeburn  2763:             if ($in{'mode'} eq 'modifycourse') {
                   2764:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2765:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2766:                 }
                   2767:             }
                   2768:         }
1.586     raeburn  2769:     }
                   2770:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2771:     if ($authtype eq '') {
                   2772:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2773:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2774:                     $jscall.'" />';
                   2775:     }
                   2776:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2777:                ' onchange="'.$jscall.'" />';
                   2778:     $result = &mt
1.144     matthew  2779:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2780:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2781:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2782:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2783:                   'onchange="'.$jscall.'" />');
1.32      matthew  2784:     return $result;
                   2785: }
                   2786: 
1.586     raeburn  2787: sub get_assignable_auth {
                   2788:     my ($dom) = @_;
                   2789:     if ($dom eq '') {
                   2790:         $dom = $env{'request.role.domain'};
                   2791:     }
                   2792:     my %can_assign = (
                   2793:                           krb4 => 1,
                   2794:                           krb5 => 1,
                   2795:                           int  => 1,
                   2796:                           loc  => 1,
                   2797:                      );
                   2798:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2799:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2800:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2801:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2802:             my $context;
                   2803:             if ($env{'request.role'} =~ /^au/) {
                   2804:                 $context = 'author';
                   2805:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2806:                 $context = 'domain';
                   2807:             } elsif ($env{'request.course.id'}) {
                   2808:                 $context = 'course';
                   2809:             }
                   2810:             if ($context) {
                   2811:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2812:                    %can_assign = %{$authhash->{$context}}; 
                   2813:                 }
                   2814:             }
                   2815:         }
                   2816:     }
                   2817:     my $authnum = 0;
                   2818:     foreach my $key (keys(%can_assign)) {
                   2819:         if ($can_assign{$key}) {
                   2820:             $authnum ++;
                   2821:         }
                   2822:     }
                   2823:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2824:         $authnum --;
                   2825:     }
                   2826:     return ($authnum,%can_assign);
                   2827: }
                   2828: 
1.80      albertel 2829: ###############################################################
                   2830: ##    Get Kerberos Defaults for Domain                 ##
                   2831: ###############################################################
                   2832: ##
                   2833: ## Returns default kerberos version and an associated argument
                   2834: ## as listed in file domain.tab. If not listed, provides
                   2835: ## appropriate default domain and kerberos version.
                   2836: ##
                   2837: #-------------------------------------------
                   2838: 
                   2839: =pod
                   2840: 
1.648     raeburn  2841: =item * &get_kerberos_defaults()
1.80      albertel 2842: 
                   2843: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2844: version and domain. If not found, it defaults to version 4 and the 
                   2845: domain of the server.
1.80      albertel 2846: 
1.648     raeburn  2847: =over 4
                   2848: 
1.80      albertel 2849: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2850: 
1.648     raeburn  2851: =back
                   2852: 
                   2853: =back
                   2854: 
1.80      albertel 2855: =cut
                   2856: 
                   2857: #-------------------------------------------
                   2858: sub get_kerberos_defaults {
                   2859:     my $domain=shift;
1.641     raeburn  2860:     my ($krbdef,$krbdefdom);
                   2861:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2862:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2863:         $krbdef = $domdefaults{'auth_def'};
                   2864:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2865:     } else {
1.80      albertel 2866:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2867:         my $krbdefdom=$1;
                   2868:         $krbdefdom=~tr/a-z/A-Z/;
                   2869:         $krbdef = "krb4";
                   2870:     }
                   2871:     return ($krbdef,$krbdefdom);
                   2872: }
1.112     bowersj2 2873: 
1.32      matthew  2874: 
1.46      matthew  2875: ###############################################################
                   2876: ##                Thesaurus Functions                        ##
                   2877: ###############################################################
1.20      www      2878: 
1.46      matthew  2879: =pod
1.20      www      2880: 
1.112     bowersj2 2881: =head1 Thesaurus Functions
                   2882: 
                   2883: =over 4
                   2884: 
1.648     raeburn  2885: =item * &initialize_keywords()
1.46      matthew  2886: 
                   2887: Initializes the package variable %Keywords if it is empty.  Uses the
                   2888: package variable $thesaurus_db_file.
                   2889: 
                   2890: =cut
                   2891: 
                   2892: ###################################################
                   2893: 
                   2894: sub initialize_keywords {
                   2895:     return 1 if (scalar keys(%Keywords));
                   2896:     # If we are here, %Keywords is empty, so fill it up
                   2897:     #   Make sure the file we need exists...
                   2898:     if (! -e $thesaurus_db_file) {
                   2899:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2900:                                  " failed because it does not exist");
                   2901:         return 0;
                   2902:     }
                   2903:     #   Set up the hash as a database
                   2904:     my %thesaurus_db;
                   2905:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2906:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2907:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2908:                                  $thesaurus_db_file);
                   2909:         return 0;
                   2910:     } 
                   2911:     #  Get the average number of appearances of a word.
                   2912:     my $avecount = $thesaurus_db{'average.count'};
                   2913:     #  Put keywords (those that appear > average) into %Keywords
                   2914:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2915:         my ($count,undef) = split /:/,$data;
                   2916:         $Keywords{$word}++ if ($count > $avecount);
                   2917:     }
                   2918:     untie %thesaurus_db;
                   2919:     # Remove special values from %Keywords.
1.356     albertel 2920:     foreach my $value ('total.count','average.count') {
                   2921:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2922:   }
1.46      matthew  2923:     return 1;
                   2924: }
                   2925: 
                   2926: ###################################################
                   2927: 
                   2928: =pod
                   2929: 
1.648     raeburn  2930: =item * &keyword($word)
1.46      matthew  2931: 
                   2932: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2933: than the average number of times in the thesaurus database.  Calls 
                   2934: &initialize_keywords
                   2935: 
                   2936: =cut
                   2937: 
                   2938: ###################################################
1.20      www      2939: 
                   2940: sub keyword {
1.46      matthew  2941:     return if (!&initialize_keywords());
                   2942:     my $word=lc(shift());
                   2943:     $word=~s/\W//g;
                   2944:     return exists($Keywords{$word});
1.20      www      2945: }
1.46      matthew  2946: 
                   2947: ###############################################################
                   2948: 
                   2949: =pod 
1.20      www      2950: 
1.648     raeburn  2951: =item * &get_related_words()
1.46      matthew  2952: 
1.160     matthew  2953: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2954: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2955: will be returned.  The order of the words returned is determined by the
                   2956: database which holds them.
                   2957: 
                   2958: Uses global $thesaurus_db_file.
                   2959: 
1.1057    foxr     2960: 
1.46      matthew  2961: =cut
                   2962: 
                   2963: ###############################################################
                   2964: sub get_related_words {
                   2965:     my $keyword = shift;
                   2966:     my %thesaurus_db;
                   2967:     if (! -e $thesaurus_db_file) {
                   2968:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2969:                                  "failed because the file does not exist");
                   2970:         return ();
                   2971:     }
                   2972:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2973:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2974:         return ();
                   2975:     } 
                   2976:     my @Words=();
1.429     www      2977:     my $count=0;
1.46      matthew  2978:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2979: 	# The first element is the number of times
                   2980: 	# the word appears.  We do not need it now.
1.429     www      2981: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2982: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2983: 	my $threshold=$mostfrequentcount/10;
                   2984:         foreach my $possibleword (@RelatedWords) {
                   2985:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2986:             if ($wordcount>$threshold) {
                   2987: 		push(@Words,$word);
                   2988:                 $count++;
                   2989:                 if ($count>10) { last; }
                   2990: 	    }
1.20      www      2991:         }
                   2992:     }
1.46      matthew  2993:     untie %thesaurus_db;
                   2994:     return @Words;
1.14      harris41 2995: }
1.46      matthew  2996: 
1.112     bowersj2 2997: =pod
                   2998: 
                   2999: =back
                   3000: 
                   3001: =cut
1.61      www      3002: 
                   3003: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3004: =pod
                   3005: 
1.112     bowersj2 3006: =head1 User Name Functions
                   3007: 
                   3008: =over 4
                   3009: 
1.648     raeburn  3010: =item * &plainname($uname,$udom,$first)
1.81      albertel 3011: 
1.112     bowersj2 3012: Takes a users logon name and returns it as a string in
1.226     albertel 3013: "first middle last generation" form 
                   3014: if $first is set to 'lastname' then it returns it as
                   3015: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3016: 
                   3017: =cut
1.61      www      3018: 
1.295     www      3019: 
1.81      albertel 3020: ###############################################################
1.61      www      3021: sub plainname {
1.226     albertel 3022:     my ($uname,$udom,$first)=@_;
1.537     albertel 3023:     return if (!defined($uname) || !defined($udom));
1.295     www      3024:     my %names=&getnames($uname,$udom);
1.226     albertel 3025:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3026: 					  $names{'middlename'},
                   3027: 					  $names{'lastname'},
                   3028: 					  $names{'generation'},$first);
                   3029:     $name=~s/^\s+//;
1.62      www      3030:     $name=~s/\s+$//;
                   3031:     $name=~s/\s+/ /g;
1.353     albertel 3032:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3033:     return $name;
1.61      www      3034: }
1.66      www      3035: 
                   3036: # -------------------------------------------------------------------- Nickname
1.81      albertel 3037: =pod
                   3038: 
1.648     raeburn  3039: =item * &nickname($uname,$udom)
1.81      albertel 3040: 
                   3041: Gets a users name and returns it as a string as
                   3042: 
                   3043: "&quot;nickname&quot;"
1.66      www      3044: 
1.81      albertel 3045: if the user has a nickname or
                   3046: 
                   3047: "first middle last generation"
                   3048: 
                   3049: if the user does not
                   3050: 
                   3051: =cut
1.66      www      3052: 
                   3053: sub nickname {
                   3054:     my ($uname,$udom)=@_;
1.537     albertel 3055:     return if (!defined($uname) || !defined($udom));
1.295     www      3056:     my %names=&getnames($uname,$udom);
1.68      albertel 3057:     my $name=$names{'nickname'};
1.66      www      3058:     if ($name) {
                   3059:        $name='&quot;'.$name.'&quot;'; 
                   3060:     } else {
                   3061:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3062: 	     $names{'lastname'}.' '.$names{'generation'};
                   3063:        $name=~s/\s+$//;
                   3064:        $name=~s/\s+/ /g;
                   3065:     }
                   3066:     return $name;
                   3067: }
                   3068: 
1.295     www      3069: sub getnames {
                   3070:     my ($uname,$udom)=@_;
1.537     albertel 3071:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3072:     if ($udom eq 'public' && $uname eq 'public') {
                   3073: 	return ('lastname' => &mt('Public'));
                   3074:     }
1.295     www      3075:     my $id=$uname.':'.$udom;
                   3076:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3077:     if ($cached) {
                   3078: 	return %{$names};
                   3079:     } else {
                   3080: 	my %loadnames=&Apache::lonnet::get('environment',
                   3081:                     ['firstname','middlename','lastname','generation','nickname'],
                   3082: 					 $udom,$uname);
                   3083: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3084: 	return %loadnames;
                   3085:     }
                   3086: }
1.61      www      3087: 
1.542     raeburn  3088: # -------------------------------------------------------------------- getemails
1.648     raeburn  3089: 
1.542     raeburn  3090: =pod
                   3091: 
1.648     raeburn  3092: =item * &getemails($uname,$udom)
1.542     raeburn  3093: 
                   3094: Gets a user's email information and returns it as a hash with keys:
                   3095: notification, critnotification, permanentemail
                   3096: 
                   3097: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3098: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3099:  
1.648     raeburn  3100: 
1.542     raeburn  3101: =cut
                   3102: 
1.648     raeburn  3103: 
1.466     albertel 3104: sub getemails {
                   3105:     my ($uname,$udom)=@_;
                   3106:     if ($udom eq 'public' && $uname eq 'public') {
                   3107: 	return;
                   3108:     }
1.467     www      3109:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3110:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3111:     my $id=$uname.':'.$udom;
                   3112:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3113:     if ($cached) {
                   3114: 	return %{$names};
                   3115:     } else {
                   3116: 	my %loadnames=&Apache::lonnet::get('environment',
                   3117:                     			   ['notification','critnotification',
                   3118: 					    'permanentemail'],
                   3119: 					   $udom,$uname);
                   3120: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3121: 	return %loadnames;
                   3122:     }
                   3123: }
                   3124: 
1.551     albertel 3125: sub flush_email_cache {
                   3126:     my ($uname,$udom)=@_;
                   3127:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3128:     if (!$uname) { $uname=$env{'user.name'};   }
                   3129:     return if ($udom eq 'public' && $uname eq 'public');
                   3130:     my $id=$uname.':'.$udom;
                   3131:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3132: }
                   3133: 
1.728     raeburn  3134: # -------------------------------------------------------------------- getlangs
                   3135: 
                   3136: =pod
                   3137: 
                   3138: =item * &getlangs($uname,$udom)
                   3139: 
                   3140: Gets a user's language preference and returns it as a hash with key:
                   3141: language.
                   3142: 
                   3143: =cut
                   3144: 
                   3145: 
                   3146: sub getlangs {
                   3147:     my ($uname,$udom) = @_;
                   3148:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3149:     if (!$uname) { $uname=$env{'user.name'};   }
                   3150:     my $id=$uname.':'.$udom;
                   3151:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3152:     if ($cached) {
                   3153:         return %{$langs};
                   3154:     } else {
                   3155:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3156:                                            $udom,$uname);
                   3157:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3158:         return %loadlangs;
                   3159:     }
                   3160: }
                   3161: 
                   3162: sub flush_langs_cache {
                   3163:     my ($uname,$udom)=@_;
                   3164:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3165:     if (!$uname) { $uname=$env{'user.name'};   }
                   3166:     return if ($udom eq 'public' && $uname eq 'public');
                   3167:     my $id=$uname.':'.$udom;
                   3168:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3169: }
                   3170: 
1.61      www      3171: # ------------------------------------------------------------------ Screenname
1.81      albertel 3172: 
                   3173: =pod
                   3174: 
1.648     raeburn  3175: =item * &screenname($uname,$udom)
1.81      albertel 3176: 
                   3177: Gets a users screenname and returns it as a string
                   3178: 
                   3179: =cut
1.61      www      3180: 
                   3181: sub screenname {
                   3182:     my ($uname,$udom)=@_;
1.258     albertel 3183:     if ($uname eq $env{'user.name'} &&
                   3184: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3185:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3186:     return $names{'screenname'};
1.62      www      3187: }
                   3188: 
1.212     albertel 3189: 
1.802     bisitz   3190: # ------------------------------------------------------------- Confirm Wrapper
                   3191: =pod
                   3192: 
                   3193: =item confirmwrapper
                   3194: 
                   3195: Wrap messages about completion of operation in box
                   3196: 
                   3197: =cut
                   3198: 
                   3199: sub confirmwrapper {
                   3200:     my ($message)=@_;
                   3201:     if ($message) {
                   3202:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3203:                .$message."\n"
                   3204:                .'</div>'."\n";
                   3205:     } else {
                   3206:         return $message;
                   3207:     }
                   3208: }
                   3209: 
1.62      www      3210: # ------------------------------------------------------------- Message Wrapper
                   3211: 
                   3212: sub messagewrapper {
1.369     www      3213:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3214:     return 
1.441     albertel 3215:         '<a href="/adm/email?compose=individual&amp;'.
                   3216:         'recname='.$username.'&amp;recdom='.$domain.
                   3217: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3218:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3219: }
1.802     bisitz   3220: 
1.74      www      3221: # --------------------------------------------------------------- Notes Wrapper
                   3222: 
                   3223: sub noteswrapper {
                   3224:     my ($link,$un,$do)=@_;
                   3225:     return 
1.896     amueller 3226: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3227: }
1.802     bisitz   3228: 
1.62      www      3229: # ------------------------------------------------------------- Aboutme Wrapper
                   3230: 
                   3231: sub aboutmewrapper {
1.1070    raeburn  3232:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3233:     if (!defined($username)  && !defined($domain)) {
                   3234:         return;
                   3235:     }
1.1075.2.15  raeburn  3236:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3237: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3238: }
                   3239: 
                   3240: # ------------------------------------------------------------ Syllabus Wrapper
                   3241: 
                   3242: sub syllabuswrapper {
1.707     bisitz   3243:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3244:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3245: }
1.14      harris41 3246: 
1.802     bisitz   3247: # -----------------------------------------------------------------------------
                   3248: 
1.208     matthew  3249: sub track_student_link {
1.887     raeburn  3250:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3251:     my $link ="/adm/trackstudent?";
1.208     matthew  3252:     my $title = 'View recent activity';
                   3253:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3254:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3255:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3256:         $title .= ' of this student';
1.268     albertel 3257:     } 
1.208     matthew  3258:     if (defined($target) && $target !~ /^\s*$/) {
                   3259:         $target = qq{target="$target"};
                   3260:     } else {
                   3261:         $target = '';
                   3262:     }
1.268     albertel 3263:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3264:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3265:     $title = &mt($title);
                   3266:     $linktext = &mt($linktext);
1.448     albertel 3267:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3268: 	&help_open_topic('View_recent_activity');
1.208     matthew  3269: }
                   3270: 
1.781     raeburn  3271: sub slot_reservations_link {
                   3272:     my ($linktext,$sname,$sdom,$target) = @_;
                   3273:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3274:     my $title = 'View slot reservation history';
                   3275:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3276:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3277:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3278:         $title .= ' of this student';
                   3279:     }
                   3280:     if (defined($target) && $target !~ /^\s*$/) {
                   3281:         $target = qq{target="$target"};
                   3282:     } else {
                   3283:         $target = '';
                   3284:     }
                   3285:     $title = &mt($title);
                   3286:     $linktext = &mt($linktext);
                   3287:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3288: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3289: 
                   3290: }
                   3291: 
1.508     www      3292: # ===================================================== Display a student photo
                   3293: 
                   3294: 
1.509     albertel 3295: sub student_image_tag {
1.508     www      3296:     my ($domain,$user)=@_;
                   3297:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3298:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3299: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3300:     } else {
                   3301: 	return '';
                   3302:     }
                   3303: }
                   3304: 
1.112     bowersj2 3305: =pod
                   3306: 
                   3307: =back
                   3308: 
                   3309: =head1 Access .tab File Data
                   3310: 
                   3311: =over 4
                   3312: 
1.648     raeburn  3313: =item * &languageids() 
1.112     bowersj2 3314: 
                   3315: returns list of all language ids
                   3316: 
                   3317: =cut
                   3318: 
1.14      harris41 3319: sub languageids {
1.16      harris41 3320:     return sort(keys(%language));
1.14      harris41 3321: }
                   3322: 
1.112     bowersj2 3323: =pod
                   3324: 
1.648     raeburn  3325: =item * &languagedescription() 
1.112     bowersj2 3326: 
                   3327: returns description of a specified language id
                   3328: 
                   3329: =cut
                   3330: 
1.14      harris41 3331: sub languagedescription {
1.125     www      3332:     my $code=shift;
                   3333:     return  ($supported_language{$code}?'* ':'').
                   3334:             $language{$code}.
1.126     www      3335: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3336: }
                   3337: 
1.1048    foxr     3338: =pod
                   3339: 
                   3340: =item * &plainlanguagedescription
                   3341: 
                   3342: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3343: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3344: 
                   3345: =cut
                   3346: 
1.145     www      3347: sub plainlanguagedescription {
                   3348:     my $code=shift;
                   3349:     return $language{$code};
                   3350: }
                   3351: 
1.1048    foxr     3352: =pod
                   3353: 
                   3354: =item * &supportedlanguagecode
                   3355: 
                   3356: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3357: code.
                   3358: 
                   3359: =cut
                   3360: 
1.145     www      3361: sub supportedlanguagecode {
                   3362:     my $code=shift;
                   3363:     return $supported_language{$code};
1.97      www      3364: }
                   3365: 
1.112     bowersj2 3366: =pod
                   3367: 
1.1048    foxr     3368: =item * &latexlanguage()
                   3369: 
                   3370: Given a language key code returns the correspondnig language to use
                   3371: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3372: is no supported hyphenation for the language code.
                   3373: 
                   3374: =cut
                   3375: 
                   3376: sub latexlanguage {
                   3377:     my $code = shift;
                   3378:     return $latex_language{$code};
                   3379: }
                   3380: 
                   3381: =pod
                   3382: 
                   3383: =item * &latexhyphenation()
                   3384: 
                   3385: Same as above but what's supplied is the language as it might be stored
                   3386: in the metadata.
                   3387: 
                   3388: =cut
                   3389: 
                   3390: sub latexhyphenation {
                   3391:     my $key = shift;
                   3392:     return $latex_language_bykey{$key};
                   3393: }
                   3394: 
                   3395: =pod
                   3396: 
1.648     raeburn  3397: =item * &copyrightids() 
1.112     bowersj2 3398: 
                   3399: returns list of all copyrights
                   3400: 
                   3401: =cut
                   3402: 
                   3403: sub copyrightids {
                   3404:     return sort(keys(%cprtag));
                   3405: }
                   3406: 
                   3407: =pod
                   3408: 
1.648     raeburn  3409: =item * &copyrightdescription() 
1.112     bowersj2 3410: 
                   3411: returns description of a specified copyright id
                   3412: 
                   3413: =cut
                   3414: 
                   3415: sub copyrightdescription {
1.166     www      3416:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3417: }
1.197     matthew  3418: 
                   3419: =pod
                   3420: 
1.648     raeburn  3421: =item * &source_copyrightids() 
1.192     taceyjo1 3422: 
                   3423: returns list of all source copyrights
                   3424: 
                   3425: =cut
                   3426: 
                   3427: sub source_copyrightids {
                   3428:     return sort(keys(%scprtag));
                   3429: }
                   3430: 
                   3431: =pod
                   3432: 
1.648     raeburn  3433: =item * &source_copyrightdescription() 
1.192     taceyjo1 3434: 
                   3435: returns description of a specified source copyright id
                   3436: 
                   3437: =cut
                   3438: 
                   3439: sub source_copyrightdescription {
                   3440:     return &mt($scprtag{shift(@_)});
                   3441: }
1.112     bowersj2 3442: 
                   3443: =pod
                   3444: 
1.648     raeburn  3445: =item * &filecategories() 
1.112     bowersj2 3446: 
                   3447: returns list of all file categories
                   3448: 
                   3449: =cut
                   3450: 
                   3451: sub filecategories {
                   3452:     return sort(keys(%category_extensions));
                   3453: }
                   3454: 
                   3455: =pod
                   3456: 
1.648     raeburn  3457: =item * &filecategorytypes() 
1.112     bowersj2 3458: 
                   3459: returns list of file types belonging to a given file
                   3460: category
                   3461: 
                   3462: =cut
                   3463: 
                   3464: sub filecategorytypes {
1.356     albertel 3465:     my ($cat) = @_;
                   3466:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3467: }
                   3468: 
                   3469: =pod
                   3470: 
1.648     raeburn  3471: =item * &fileembstyle() 
1.112     bowersj2 3472: 
                   3473: returns embedding style for a specified file type
                   3474: 
                   3475: =cut
                   3476: 
                   3477: sub fileembstyle {
                   3478:     return $fe{lc(shift(@_))};
1.169     www      3479: }
                   3480: 
1.351     www      3481: sub filemimetype {
                   3482:     return $fm{lc(shift(@_))};
                   3483: }
                   3484: 
1.169     www      3485: 
                   3486: sub filecategoryselect {
                   3487:     my ($name,$value)=@_;
1.189     matthew  3488:     return &select_form($value,$name,
1.970     raeburn  3489:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3490: }
                   3491: 
                   3492: =pod
                   3493: 
1.648     raeburn  3494: =item * &filedescription() 
1.112     bowersj2 3495: 
                   3496: returns description for a specified file type
                   3497: 
                   3498: =cut
                   3499: 
                   3500: sub filedescription {
1.188     matthew  3501:     my $file_description = $fd{lc(shift())};
                   3502:     $file_description =~ s:([\[\]]):~$1:g;
                   3503:     return &mt($file_description);
1.112     bowersj2 3504: }
                   3505: 
                   3506: =pod
                   3507: 
1.648     raeburn  3508: =item * &filedescriptionex() 
1.112     bowersj2 3509: 
                   3510: returns description for a specified file type with
                   3511: extra formatting
                   3512: 
                   3513: =cut
                   3514: 
                   3515: sub filedescriptionex {
                   3516:     my $ex=shift;
1.188     matthew  3517:     my $file_description = $fd{lc($ex)};
                   3518:     $file_description =~ s:([\[\]]):~$1:g;
                   3519:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3520: }
                   3521: 
                   3522: # End of .tab access
                   3523: =pod
                   3524: 
                   3525: =back
                   3526: 
                   3527: =cut
                   3528: 
                   3529: # ------------------------------------------------------------------ File Types
                   3530: sub fileextensions {
                   3531:     return sort(keys(%fe));
                   3532: }
                   3533: 
1.97      www      3534: # ----------------------------------------------------------- Display Languages
                   3535: # returns a hash with all desired display languages
                   3536: #
                   3537: 
                   3538: sub display_languages {
                   3539:     my %languages=();
1.695     raeburn  3540:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3541: 	$languages{$lang}=1;
1.97      www      3542:     }
                   3543:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3544:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3545: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3546: 	    $languages{$lang}=1;
1.97      www      3547:         }
                   3548:     }
                   3549:     return %languages;
1.14      harris41 3550: }
                   3551: 
1.582     albertel 3552: sub languages {
                   3553:     my ($possible_langs) = @_;
1.695     raeburn  3554:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3555:     if (!ref($possible_langs)) {
                   3556: 	if( wantarray ) {
                   3557: 	    return @preferred_langs;
                   3558: 	} else {
                   3559: 	    return $preferred_langs[0];
                   3560: 	}
                   3561:     }
                   3562:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3563:     my @preferred_possibilities;
                   3564:     foreach my $preferred_lang (@preferred_langs) {
                   3565: 	if (exists($possibilities{$preferred_lang})) {
                   3566: 	    push(@preferred_possibilities, $preferred_lang);
                   3567: 	}
                   3568:     }
                   3569:     if( wantarray ) {
                   3570: 	return @preferred_possibilities;
                   3571:     }
                   3572:     return $preferred_possibilities[0];
                   3573: }
                   3574: 
1.742     raeburn  3575: sub user_lang {
                   3576:     my ($touname,$toudom,$fromcid) = @_;
                   3577:     my @userlangs;
                   3578:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3579:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3580:                     $env{'course.'.$fromcid.'.languages'}));
                   3581:     } else {
                   3582:         my %langhash = &getlangs($touname,$toudom);
                   3583:         if ($langhash{'languages'} ne '') {
                   3584:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3585:         } else {
                   3586:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3587:             if ($domdefs{'lang_def'} ne '') {
                   3588:                 @userlangs = ($domdefs{'lang_def'});
                   3589:             }
                   3590:         }
                   3591:     }
                   3592:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3593:     my $user_lh = Apache::localize->get_handle(@languages);
                   3594:     return $user_lh;
                   3595: }
                   3596: 
                   3597: 
1.112     bowersj2 3598: ###############################################################
                   3599: ##               Student Answer Attempts                     ##
                   3600: ###############################################################
                   3601: 
                   3602: =pod
                   3603: 
                   3604: =head1 Alternate Problem Views
                   3605: 
                   3606: =over 4
                   3607: 
1.648     raeburn  3608: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3609:     $getattempt, $regexp, $gradesub)
                   3610: 
                   3611: Return string with previous attempt on problem. Arguments:
                   3612: 
                   3613: =over 4
                   3614: 
                   3615: =item * $symb: Problem, including path
                   3616: 
                   3617: =item * $username: username of the desired student
                   3618: 
                   3619: =item * $domain: domain of the desired student
1.14      harris41 3620: 
1.112     bowersj2 3621: =item * $course: Course ID
1.14      harris41 3622: 
1.112     bowersj2 3623: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3624:     something
1.14      harris41 3625: 
1.112     bowersj2 3626: =item * $regexp: if string matches this regexp, the string will be
                   3627:     sent to $gradesub
1.14      harris41 3628: 
1.112     bowersj2 3629: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3630: 
1.112     bowersj2 3631: =back
1.14      harris41 3632: 
1.112     bowersj2 3633: The output string is a table containing all desired attempts, if any.
1.16      harris41 3634: 
1.112     bowersj2 3635: =cut
1.1       albertel 3636: 
                   3637: sub get_previous_attempt {
1.43      ng       3638:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3639:   my $prevattempts='';
1.43      ng       3640:   no strict 'refs';
1.1       albertel 3641:   if ($symb) {
1.3       albertel 3642:     my (%returnhash)=
                   3643:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3644:     if ($returnhash{'version'}) {
                   3645:       my %lasthash=();
                   3646:       my $version;
                   3647:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3648:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3649: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3650:         }
1.1       albertel 3651:       }
1.596     albertel 3652:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3653:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3654:       my (%typeparts,%lasthidden);
1.945     raeburn  3655:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3656:       foreach my $key (sort(keys(%lasthash))) {
                   3657: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3658: 	if ($#parts > 0) {
1.31      albertel 3659: 	  my $data=$parts[-1];
1.989     raeburn  3660:           next if ($data eq 'foilorder');
1.31      albertel 3661: 	  pop(@parts);
1.1010    www      3662:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3663:           if ($data eq 'type') {
                   3664:               unless ($showsurv) {
                   3665:                   my $id = join(',',@parts);
                   3666:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3667:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3668:                       $lasthidden{$ign.'.'.$id} = 1;
                   3669:                   }
1.945     raeburn  3670:               }
1.1010    www      3671:           } 
1.31      albertel 3672: 	} else {
1.41      ng       3673: 	  if ($#parts == 0) {
                   3674: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3675: 	  } else {
                   3676: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3677: 	  }
1.31      albertel 3678: 	}
1.16      harris41 3679:       }
1.596     albertel 3680:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3681:       if ($getattempt eq '') {
                   3682: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3683:             my @hidden;
                   3684:             if (%typeparts) {
                   3685:                 foreach my $id (keys(%typeparts)) {
                   3686:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3687:                         push(@hidden,$id);
                   3688:                     }
                   3689:                 }
                   3690:             }
                   3691:             $prevattempts.=&start_data_table_row().
                   3692:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3693:             if (@hidden) {
                   3694:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3695:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3696:                     my $hide;
                   3697:                     foreach my $id (@hidden) {
                   3698:                         if ($key =~ /^\Q$id\E/) {
                   3699:                             $hide = 1;
                   3700:                             last;
                   3701:                         }
                   3702:                     }
                   3703:                     if ($hide) {
                   3704:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3705:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3706:                             my $value = &format_previous_attempt_value($key,
                   3707:                                              $returnhash{$version.':'.$key});
                   3708:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3709:                         } else {
                   3710:                             $prevattempts.='<td>&nbsp;</td>';
                   3711:                         }
                   3712:                     } else {
                   3713:                         if ($key =~ /\./) {
                   3714:                             my $value = &format_previous_attempt_value($key,
                   3715:                                               $returnhash{$version.':'.$key});
                   3716:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3717:                         } else {
                   3718:                             $prevattempts.='<td>&nbsp;</td>';
                   3719:                         }
                   3720:                     }
                   3721:                 }
                   3722:             } else {
                   3723: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3724:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3725: 		    my $value = &format_previous_attempt_value($key,
                   3726: 			            $returnhash{$version.':'.$key});
                   3727: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3728: 	        }
                   3729:             }
                   3730: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3731: 	 }
1.1       albertel 3732:       }
1.945     raeburn  3733:       my @currhidden = keys(%lasthidden);
1.596     albertel 3734:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3735:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3736:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3737:           if (%typeparts) {
                   3738:               my $hidden;
                   3739:               foreach my $id (@currhidden) {
                   3740:                   if ($key =~ /^\Q$id\E/) {
                   3741:                       $hidden = 1;
                   3742:                       last;
                   3743:                   }
                   3744:               }
                   3745:               if ($hidden) {
                   3746:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3747:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3748:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3749:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3750:                           $value = &$gradesub($value);
                   3751:                       }
                   3752:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3753:                   } else {
                   3754:                       $prevattempts.='<td>&nbsp;</td>';
                   3755:                   }
                   3756:               } else {
                   3757:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3758:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3759:                       $value = &$gradesub($value);
                   3760:                   }
                   3761:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3762:               }
                   3763:           } else {
                   3764: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3765: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3766:                   $value = &$gradesub($value);
                   3767:               }
                   3768: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3769:           }
1.16      harris41 3770:       }
1.596     albertel 3771:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3772:     } else {
1.596     albertel 3773:       $prevattempts=
                   3774: 	  &start_data_table().&start_data_table_row().
                   3775: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3776: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3777:     }
                   3778:   } else {
1.596     albertel 3779:     $prevattempts=
                   3780: 	  &start_data_table().&start_data_table_row().
                   3781: 	  '<td>'.&mt('No data.').'</td>'.
                   3782: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3783:   }
1.10      albertel 3784: }
                   3785: 
1.581     albertel 3786: sub format_previous_attempt_value {
                   3787:     my ($key,$value) = @_;
1.1011    www      3788:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3789: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3790:     } elsif (ref($value) eq 'ARRAY') {
                   3791: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3792:     } elsif ($key =~ /answerstring$/) {
                   3793:         my %answers = &Apache::lonnet::str2hash($value);
                   3794:         my @anskeys = sort(keys(%answers));
                   3795:         if (@anskeys == 1) {
                   3796:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3797:             if ($answer =~ m{\0}) {
                   3798:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3799:             }
                   3800:             my $tag_internal_answer_name = 'INTERNAL';
                   3801:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3802:                 $value = $answer; 
                   3803:             } else {
                   3804:                 $value = $anskeys[0].'='.$answer;
                   3805:             }
                   3806:         } else {
                   3807:             foreach my $ans (@anskeys) {
                   3808:                 my $answer = $answers{$ans};
1.1001    raeburn  3809:                 if ($answer =~ m{\0}) {
                   3810:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3811:                 }
                   3812:                 $value .=  $ans.'='.$answer.'<br />';;
                   3813:             } 
                   3814:         }
1.581     albertel 3815:     } else {
                   3816: 	$value = &unescape($value);
                   3817:     }
                   3818:     return $value;
                   3819: }
                   3820: 
                   3821: 
1.107     albertel 3822: sub relative_to_absolute {
                   3823:     my ($url,$output)=@_;
                   3824:     my $parser=HTML::TokeParser->new(\$output);
                   3825:     my $token;
                   3826:     my $thisdir=$url;
                   3827:     my @rlinks=();
                   3828:     while ($token=$parser->get_token) {
                   3829: 	if ($token->[0] eq 'S') {
                   3830: 	    if ($token->[1] eq 'a') {
                   3831: 		if ($token->[2]->{'href'}) {
                   3832: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3833: 		}
                   3834: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3835: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3836: 	    } elsif ($token->[1] eq 'base') {
                   3837: 		$thisdir=$token->[2]->{'href'};
                   3838: 	    }
                   3839: 	}
                   3840:     }
                   3841:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3842:     foreach my $link (@rlinks) {
1.726     raeburn  3843: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3844: 		($link=~/^\//) ||
                   3845: 		($link=~/^javascript:/i) ||
                   3846: 		($link=~/^mailto:/i) ||
                   3847: 		($link=~/^\#/)) {
                   3848: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3849: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3850: 	}
                   3851:     }
                   3852: # -------------------------------------------------- Deal with Applet codebases
                   3853:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3854:     return $output;
                   3855: }
                   3856: 
1.112     bowersj2 3857: =pod
                   3858: 
1.648     raeburn  3859: =item * &get_student_view()
1.112     bowersj2 3860: 
                   3861: show a snapshot of what student was looking at
                   3862: 
                   3863: =cut
                   3864: 
1.10      albertel 3865: sub get_student_view {
1.186     albertel 3866:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3867:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3868:   my (%form);
1.10      albertel 3869:   my @elements=('symb','courseid','domain','username');
                   3870:   foreach my $element (@elements) {
1.186     albertel 3871:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3872:   }
1.186     albertel 3873:   if (defined($moreenv)) {
                   3874:       %form=(%form,%{$moreenv});
                   3875:   }
1.236     albertel 3876:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3877:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3878:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3879:   $userview=~s/\<body[^\>]*\>//gi;
                   3880:   $userview=~s/\<\/body\>//gi;
                   3881:   $userview=~s/\<html\>//gi;
                   3882:   $userview=~s/\<\/html\>//gi;
                   3883:   $userview=~s/\<head\>//gi;
                   3884:   $userview=~s/\<\/head\>//gi;
                   3885:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3886:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3887:   if (wantarray) {
                   3888:      return ($userview,$response);
                   3889:   } else {
                   3890:      return $userview;
                   3891:   }
                   3892: }
                   3893: 
                   3894: sub get_student_view_with_retries {
                   3895:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3896: 
                   3897:     my $ok = 0;                 # True if we got a good response.
                   3898:     my $content;
                   3899:     my $response;
                   3900: 
                   3901:     # Try to get the student_view done. within the retries count:
                   3902:     
                   3903:     do {
                   3904:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3905:          $ok      = $response->is_success;
                   3906:          if (!$ok) {
                   3907:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3908:          }
                   3909:          $retries--;
                   3910:     } while (!$ok && ($retries > 0));
                   3911:     
                   3912:     if (!$ok) {
                   3913:        $content = '';          # On error return an empty content.
                   3914:     }
1.651     www      3915:     if (wantarray) {
                   3916:        return ($content, $response);
                   3917:     } else {
                   3918:        return $content;
                   3919:     }
1.11      albertel 3920: }
                   3921: 
1.112     bowersj2 3922: =pod
                   3923: 
1.648     raeburn  3924: =item * &get_student_answers() 
1.112     bowersj2 3925: 
                   3926: show a snapshot of how student was answering problem
                   3927: 
                   3928: =cut
                   3929: 
1.11      albertel 3930: sub get_student_answers {
1.100     sakharuk 3931:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3932:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3933:   my (%moreenv);
1.11      albertel 3934:   my @elements=('symb','courseid','domain','username');
                   3935:   foreach my $element (@elements) {
1.186     albertel 3936:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3937:   }
1.186     albertel 3938:   $moreenv{'grade_target'}='answer';
                   3939:   %moreenv=(%form,%moreenv);
1.497     raeburn  3940:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3941:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3942:   return $userview;
1.1       albertel 3943: }
1.116     albertel 3944: 
                   3945: =pod
                   3946: 
                   3947: =item * &submlink()
                   3948: 
1.242     albertel 3949: Inputs: $text $uname $udom $symb $target
1.116     albertel 3950: 
                   3951: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3952: 
                   3953: =cut
                   3954: 
                   3955: ###############################################
                   3956: sub submlink {
1.242     albertel 3957:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3958:     if (!($uname && $udom)) {
                   3959: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3960: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3961: 	if (!$symb) { $symb=$cursymb; }
                   3962:     }
1.254     matthew  3963:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3964:     $symb=&escape($symb);
1.960     bisitz   3965:     if ($target) { $target=" target=\"$target\""; }
                   3966:     return
                   3967:         '<a href="/adm/grades?command=submission'.
                   3968:         '&amp;symb='.$symb.
                   3969:         '&amp;student='.$uname.
                   3970:         '&amp;userdom='.$udom.'"'.
                   3971:         $target.'>'.$text.'</a>';
1.242     albertel 3972: }
                   3973: ##############################################
                   3974: 
                   3975: =pod
                   3976: 
                   3977: =item * &pgrdlink()
                   3978: 
                   3979: Inputs: $text $uname $udom $symb $target
                   3980: 
                   3981: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3982: 
                   3983: =cut
                   3984: 
                   3985: ###############################################
                   3986: sub pgrdlink {
                   3987:     my $link=&submlink(@_);
                   3988:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3989:     return $link;
                   3990: }
                   3991: ##############################################
                   3992: 
                   3993: =pod
                   3994: 
                   3995: =item * &pprmlink()
                   3996: 
                   3997: Inputs: $text $uname $udom $symb $target
                   3998: 
                   3999: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4000: student and a specific resource
1.242     albertel 4001: 
                   4002: =cut
                   4003: 
                   4004: ###############################################
                   4005: sub pprmlink {
                   4006:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4007:     if (!($uname && $udom)) {
                   4008: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4009: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4010: 	if (!$symb) { $symb=$cursymb; }
                   4011:     }
1.254     matthew  4012:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4013:     $symb=&escape($symb);
1.242     albertel 4014:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4015:     return '<a href="/adm/parmset?command=set&amp;'.
                   4016: 	'symb='.$symb.'&amp;uname='.$uname.
                   4017: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4018: }
                   4019: ##############################################
1.37      matthew  4020: 
1.112     bowersj2 4021: =pod
                   4022: 
                   4023: =back
                   4024: 
                   4025: =cut
                   4026: 
1.37      matthew  4027: ###############################################
1.51      www      4028: 
                   4029: 
                   4030: sub timehash {
1.687     raeburn  4031:     my ($thistime) = @_;
                   4032:     my $timezone = &Apache::lonlocal::gettimezone();
                   4033:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4034:                      ->set_time_zone($timezone);
                   4035:     my $wday = $dt->day_of_week();
                   4036:     if ($wday == 7) { $wday = 0; }
                   4037:     return ( 'second' => $dt->second(),
                   4038:              'minute' => $dt->minute(),
                   4039:              'hour'   => $dt->hour(),
                   4040:              'day'     => $dt->day_of_month(),
                   4041:              'month'   => $dt->month(),
                   4042:              'year'    => $dt->year(),
                   4043:              'weekday' => $wday,
                   4044:              'dayyear' => $dt->day_of_year(),
                   4045:              'dlsav'   => $dt->is_dst() );
1.51      www      4046: }
                   4047: 
1.370     www      4048: sub utc_string {
                   4049:     my ($date)=@_;
1.371     www      4050:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4051: }
                   4052: 
1.51      www      4053: sub maketime {
                   4054:     my %th=@_;
1.687     raeburn  4055:     my ($epoch_time,$timezone,$dt);
                   4056:     $timezone = &Apache::lonlocal::gettimezone();
                   4057:     eval {
                   4058:         $dt = DateTime->new( year   => $th{'year'},
                   4059:                              month  => $th{'month'},
                   4060:                              day    => $th{'day'},
                   4061:                              hour   => $th{'hour'},
                   4062:                              minute => $th{'minute'},
                   4063:                              second => $th{'second'},
                   4064:                              time_zone => $timezone,
                   4065:                          );
                   4066:     };
                   4067:     if (!$@) {
                   4068:         $epoch_time = $dt->epoch;
                   4069:         if ($epoch_time) {
                   4070:             return $epoch_time;
                   4071:         }
                   4072:     }
1.51      www      4073:     return POSIX::mktime(
                   4074:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4075:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4076: }
                   4077: 
                   4078: #########################################
1.51      www      4079: 
                   4080: sub findallcourses {
1.482     raeburn  4081:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4082:     my %roles;
                   4083:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4084:     my %courses;
1.51      www      4085:     my $now=time;
1.482     raeburn  4086:     if (!defined($uname)) {
                   4087:         $uname = $env{'user.name'};
                   4088:     }
                   4089:     if (!defined($udom)) {
                   4090:         $udom = $env{'user.domain'};
                   4091:     }
                   4092:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4093:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4094:         if (!%roles) {
                   4095:             %roles = (
                   4096:                        cc => 1,
1.907     raeburn  4097:                        co => 1,
1.482     raeburn  4098:                        in => 1,
                   4099:                        ep => 1,
                   4100:                        ta => 1,
                   4101:                        cr => 1,
                   4102:                        st => 1,
                   4103:              );
                   4104:         }
                   4105:         foreach my $entry (keys(%roleshash)) {
                   4106:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4107:             if ($trole =~ /^cr/) { 
                   4108:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4109:             } else {
                   4110:                 next if (!exists($roles{$trole}));
                   4111:             }
                   4112:             if ($tend) {
                   4113:                 next if ($tend < $now);
                   4114:             }
                   4115:             if ($tstart) {
                   4116:                 next if ($tstart > $now);
                   4117:             }
1.1058    raeburn  4118:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4119:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4120:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4121:             if ($secpart eq '') {
                   4122:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4123:                 $sec = 'none';
1.1058    raeburn  4124:                 $value .= $cnum.'/';
1.482     raeburn  4125:             } else {
                   4126:                 $cnum = $cnumpart;
                   4127:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4128:                 $value .= $cnum.'/'.$sec;
                   4129:             }
                   4130:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4131:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4132:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4133:                 }
                   4134:             } else {
                   4135:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4136:             }
1.482     raeburn  4137:         }
                   4138:     } else {
                   4139:         foreach my $key (keys(%env)) {
1.483     albertel 4140: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4141:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4142: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4143: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4144: 	        next if (%roles && !exists($roles{$role}));
                   4145: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4146:                 my $active=1;
                   4147:                 if ($starttime) {
                   4148: 		    if ($now<$starttime) { $active=0; }
                   4149:                 }
                   4150:                 if ($endtime) {
                   4151:                     if ($now>$endtime) { $active=0; }
                   4152:                 }
                   4153:                 if ($active) {
1.1058    raeburn  4154:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4155:                     if ($sec eq '') {
                   4156:                         $sec = 'none';
1.1058    raeburn  4157:                     } else {
                   4158:                         $value .= $sec;
                   4159:                     }
                   4160:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4161:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4162:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4163:                         }
                   4164:                     } else {
                   4165:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4166:                     }
1.474     raeburn  4167:                 }
                   4168:             }
1.51      www      4169:         }
                   4170:     }
1.474     raeburn  4171:     return %courses;
1.51      www      4172: }
1.37      matthew  4173: 
1.54      www      4174: ###############################################
1.474     raeburn  4175: 
                   4176: sub blockcheck {
1.1062    raeburn  4177:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4178: 
                   4179:     if (!defined($udom)) {
                   4180:         $udom = $env{'user.domain'};
                   4181:     }
                   4182:     if (!defined($uname)) {
                   4183:         $uname = $env{'user.name'};
                   4184:     }
                   4185: 
                   4186:     # If uname and udom are for a course, check for blocks in the course.
                   4187: 
                   4188:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4189:         my ($startblock,$endblock,$triggerblock) = 
                   4190:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4191:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4192:     }
1.474     raeburn  4193: 
1.502     raeburn  4194:     my $startblock = 0;
                   4195:     my $endblock = 0;
1.1062    raeburn  4196:     my $triggerblock = '';
1.482     raeburn  4197:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4198: 
1.490     raeburn  4199:     # If uname is for a user, and activity is course-specific, i.e.,
                   4200:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4201: 
1.490     raeburn  4202:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4203:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4204:         foreach my $key (keys(%live_courses)) {
                   4205:             if ($key ne $env{'request.course.id'}) {
                   4206:                 delete($live_courses{$key});
                   4207:             }
                   4208:         }
                   4209:     }
                   4210: 
                   4211:     my $otheruser = 0;
                   4212:     my %own_courses;
                   4213:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4214:         # Resource belongs to user other than current user.
                   4215:         $otheruser = 1;
                   4216:         # Gather courses for current user
                   4217:         %own_courses = 
                   4218:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4219:     }
                   4220: 
                   4221:     # Gather active course roles - course coordinator, instructor, 
                   4222:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4223: 
                   4224:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4225:         my ($cdom,$cnum);
                   4226:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4227:             $cdom = $env{'course.'.$course.'.domain'};
                   4228:             $cnum = $env{'course.'.$course.'.num'};
                   4229:         } else {
1.490     raeburn  4230:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4231:         }
                   4232:         my $no_ownblock = 0;
                   4233:         my $no_userblock = 0;
1.533     raeburn  4234:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4235:             # Check if current user has 'evb' priv for this
                   4236:             if (defined($own_courses{$course})) {
                   4237:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4238:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4239:                     if ($sec ne 'none') {
                   4240:                         $checkrole .= '/'.$sec;
                   4241:                     }
                   4242:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4243:                         $no_ownblock = 1;
                   4244:                         last;
                   4245:                     }
                   4246:                 }
                   4247:             }
                   4248:             # if they have 'evb' priv and are currently not playing student
                   4249:             next if (($no_ownblock) &&
                   4250:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4251:         }
1.474     raeburn  4252:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4253:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4254:             if ($sec ne 'none') {
1.482     raeburn  4255:                 $checkrole .= '/'.$sec;
1.474     raeburn  4256:             }
1.490     raeburn  4257:             if ($otheruser) {
                   4258:                 # Resource belongs to user other than current user.
                   4259:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4260:                 my (%allroles,%userroles);
                   4261:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4262:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4263:                         my ($trole,$tdom,$tnum,$tsec);
                   4264:                         if ($entry =~ /^cr/) {
                   4265:                             ($trole,$tdom,$tnum,$tsec) = 
                   4266:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4267:                         } else {
                   4268:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4269:                         }
                   4270:                         my ($spec,$area,$trest);
                   4271:                         $area = '/'.$tdom.'/'.$tnum;
                   4272:                         $trest = $tnum;
                   4273:                         if ($tsec ne '') {
                   4274:                             $area .= '/'.$tsec;
                   4275:                             $trest .= '/'.$tsec;
                   4276:                         }
                   4277:                         $spec = $trole.'.'.$area;
                   4278:                         if ($trole =~ /^cr/) {
                   4279:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4280:                                                               $tdom,$spec,$trest,$area);
                   4281:                         } else {
                   4282:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4283:                                                                 $tdom,$spec,$trest,$area);
                   4284:                         }
                   4285:                     }
                   4286:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4287:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4288:                         if ($1) {
                   4289:                             $no_userblock = 1;
                   4290:                             last;
                   4291:                         }
1.486     raeburn  4292:                     }
                   4293:                 }
1.490     raeburn  4294:             } else {
                   4295:                 # Resource belongs to current user
                   4296:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4297:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4298:                     $no_ownblock = 1;
                   4299:                     last;
                   4300:                 }
1.474     raeburn  4301:             }
                   4302:         }
                   4303:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4304:         next if (($no_ownblock) &&
1.491     albertel 4305:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4306:         next if ($no_userblock);
1.474     raeburn  4307: 
1.866     kalberla 4308:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4309:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4310:         
1.1062    raeburn  4311:         my ($start,$end,$trigger) = 
                   4312:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4313:         if (($start != 0) && 
                   4314:             (($startblock == 0) || ($startblock > $start))) {
                   4315:             $startblock = $start;
1.1062    raeburn  4316:             if ($trigger ne '') {
                   4317:                 $triggerblock = $trigger;
                   4318:             }
1.502     raeburn  4319:         }
                   4320:         if (($end != 0)  &&
                   4321:             (($endblock == 0) || ($endblock < $end))) {
                   4322:             $endblock = $end;
1.1062    raeburn  4323:             if ($trigger ne '') {
                   4324:                 $triggerblock = $trigger;
                   4325:             }
1.502     raeburn  4326:         }
1.490     raeburn  4327:     }
1.1062    raeburn  4328:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4329: }
                   4330: 
                   4331: sub get_blocks {
1.1062    raeburn  4332:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4333:     my $startblock = 0;
                   4334:     my $endblock = 0;
1.1062    raeburn  4335:     my $triggerblock = '';
1.490     raeburn  4336:     my $course = $cdom.'_'.$cnum;
                   4337:     $setters->{$course} = {};
                   4338:     $setters->{$course}{'staff'} = [];
                   4339:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4340:     $setters->{$course}{'triggers'} = [];
                   4341:     my (@blockers,%triggered);
                   4342:     my $now = time;
                   4343:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4344:     if ($activity eq 'docs') {
                   4345:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4346:         foreach my $block (@blockers) {
                   4347:             if ($block =~ /^firstaccess____(.+)$/) {
                   4348:                 my $item = $1;
                   4349:                 my $type = 'map';
                   4350:                 my $timersymb = $item;
                   4351:                 if ($item eq 'course') {
                   4352:                     $type = 'course';
                   4353:                 } elsif ($item =~ /___\d+___/) {
                   4354:                     $type = 'resource';
                   4355:                 } else {
                   4356:                     $timersymb = &Apache::lonnet::symbread($item);
                   4357:                 }
                   4358:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4359:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4360:                 $triggered{$block} = {
                   4361:                                        start => $start,
                   4362:                                        end   => $end,
                   4363:                                        type  => $type,
                   4364:                                      };
                   4365:             }
                   4366:         }
                   4367:     } else {
                   4368:         foreach my $block (keys(%commblocks)) {
                   4369:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4370:                 my ($start,$end) = ($1,$2);
                   4371:                 if ($start <= time && $end >= time) {
                   4372:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4373:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4374:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4375:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4376:                                     push(@blockers,$block);
                   4377:                                 }
                   4378:                             }
                   4379:                         }
                   4380:                     }
                   4381:                 }
                   4382:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4383:                 my $item = $1;
                   4384:                 my $timersymb = $item; 
                   4385:                 my $type = 'map';
                   4386:                 if ($item eq 'course') {
                   4387:                     $type = 'course';
                   4388:                 } elsif ($item =~ /___\d+___/) {
                   4389:                     $type = 'resource';
                   4390:                 } else {
                   4391:                     $timersymb = &Apache::lonnet::symbread($item);
                   4392:                 }
                   4393:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4394:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4395:                 if ($start && $end) {
                   4396:                     if (($start <= time) && ($end >= time)) {
                   4397:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4398:                             push(@blockers,$block);
                   4399:                             $triggered{$block} = {
                   4400:                                                    start => $start,
                   4401:                                                    end   => $end,
                   4402:                                                    type  => $type,
                   4403:                                                  };
                   4404:                         }
                   4405:                     }
1.490     raeburn  4406:                 }
1.1062    raeburn  4407:             }
                   4408:         }
                   4409:     }
                   4410:     foreach my $blocker (@blockers) {
                   4411:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4412:             &parse_block_record($commblocks{$blocker});
                   4413:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4414:         my ($start,$end,$triggertype);
                   4415:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4416:             ($start,$end) = ($1,$2);
                   4417:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4418:             $start = $triggered{$blocker}{'start'};
                   4419:             $end = $triggered{$blocker}{'end'};
                   4420:             $triggertype = $triggered{$blocker}{'type'};
                   4421:         }
                   4422:         if ($start) {
                   4423:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4424:             if ($triggertype) {
                   4425:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4426:             } else {
                   4427:                 push(@{$$setters{$course}{'triggers'}},0);
                   4428:             }
                   4429:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4430:                 $startblock = $start;
                   4431:                 if ($triggertype) {
                   4432:                     $triggerblock = $blocker;
1.474     raeburn  4433:                 }
                   4434:             }
1.1062    raeburn  4435:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4436:                $endblock = $end;
                   4437:                if ($triggertype) {
                   4438:                    $triggerblock = $blocker;
                   4439:                }
                   4440:             }
1.474     raeburn  4441:         }
                   4442:     }
1.1062    raeburn  4443:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4444: }
                   4445: 
                   4446: sub parse_block_record {
                   4447:     my ($record) = @_;
                   4448:     my ($setuname,$setudom,$title,$blocks);
                   4449:     if (ref($record) eq 'HASH') {
                   4450:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4451:         $title = &unescape($record->{'event'});
                   4452:         $blocks = $record->{'blocks'};
                   4453:     } else {
                   4454:         my @data = split(/:/,$record,3);
                   4455:         if (scalar(@data) eq 2) {
                   4456:             $title = $data[1];
                   4457:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4458:         } else {
                   4459:             ($setuname,$setudom,$title) = @data;
                   4460:         }
                   4461:         $blocks = { 'com' => 'on' };
                   4462:     }
                   4463:     return ($setuname,$setudom,$title,$blocks);
                   4464: }
                   4465: 
1.854     kalberla 4466: sub blocking_status {
1.1062    raeburn  4467:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4468:     my %setters;
1.890     droeschl 4469: 
1.1061    raeburn  4470: # check for active blocking
1.1062    raeburn  4471:     my ($startblock,$endblock,$triggerblock) = 
                   4472:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4473:     my $blocked = 0;
                   4474:     if ($startblock && $endblock) {
                   4475:         $blocked = 1;
                   4476:     }
1.890     droeschl 4477: 
1.1061    raeburn  4478: # caller just wants to know whether a block is active
                   4479:     if (!wantarray) { return $blocked; }
                   4480: 
                   4481: # build a link to a popup window containing the details
                   4482:     my $querystring  = "?activity=$activity";
                   4483: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4484:     if ($activity eq 'port') {
                   4485:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4486:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4487:     } elsif ($activity eq 'docs') {
                   4488:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4489:     }
1.1061    raeburn  4490: 
                   4491:     my $output .= <<'END_MYBLOCK';
                   4492: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4493:     var options = "width=" + w + ",height=" + h + ",";
                   4494:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4495:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4496:     var newWin = window.open(url, wdwName, options);
                   4497:     newWin.focus();
                   4498: }
1.890     droeschl 4499: END_MYBLOCK
1.854     kalberla 4500: 
1.1061    raeburn  4501:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4502:   
1.1061    raeburn  4503:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4504:     my $text = &mt('Communication Blocked');
                   4505:     if ($activity eq 'docs') {
                   4506:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4507:     } elsif ($activity eq 'printout') {
                   4508:         $text = &mt('Printing Blocked');
1.1062    raeburn  4509:     }
1.1061    raeburn  4510:     $output .= <<"END_BLOCK";
1.867     kalberla 4511: <div class='LC_comblock'>
1.869     kalberla 4512:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4513:   title='$text'>
                   4514:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4515:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4516:   title='$text'>$text</a>
1.867     kalberla 4517: </div>
                   4518: 
                   4519: END_BLOCK
1.474     raeburn  4520: 
1.1061    raeburn  4521:     return ($blocked, $output);
1.854     kalberla 4522: }
1.490     raeburn  4523: 
1.60      matthew  4524: ###############################################
                   4525: 
1.682     raeburn  4526: sub check_ip_acc {
                   4527:     my ($acc)=@_;
                   4528:     &Apache::lonxml::debug("acc is $acc");
                   4529:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4530:         return 1;
                   4531:     }
                   4532:     my $allowed=0;
                   4533:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4534: 
                   4535:     my $name;
                   4536:     foreach my $pattern (split(',',$acc)) {
                   4537:         $pattern =~ s/^\s*//;
                   4538:         $pattern =~ s/\s*$//;
                   4539:         if ($pattern =~ /\*$/) {
                   4540:             #35.8.*
                   4541:             $pattern=~s/\*//;
                   4542:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4543:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4544:             #35.8.3.[34-56]
                   4545:             my $low=$2;
                   4546:             my $high=$3;
                   4547:             $pattern=$1;
                   4548:             if ($ip =~ /^\Q$pattern\E/) {
                   4549:                 my $last=(split(/\./,$ip))[3];
                   4550:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4551:             }
                   4552:         } elsif ($pattern =~ /^\*/) {
                   4553:             #*.msu.edu
                   4554:             $pattern=~s/\*//;
                   4555:             if (!defined($name)) {
                   4556:                 use Socket;
                   4557:                 my $netaddr=inet_aton($ip);
                   4558:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4559:             }
                   4560:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4561:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4562:             #127.0.0.1
                   4563:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4564:         } else {
                   4565:             #some.name.com
                   4566:             if (!defined($name)) {
                   4567:                 use Socket;
                   4568:                 my $netaddr=inet_aton($ip);
                   4569:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4570:             }
                   4571:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4572:         }
                   4573:         if ($allowed) { last; }
                   4574:     }
                   4575:     return $allowed;
                   4576: }
                   4577: 
                   4578: ###############################################
                   4579: 
1.60      matthew  4580: =pod
                   4581: 
1.112     bowersj2 4582: =head1 Domain Template Functions
                   4583: 
                   4584: =over 4
                   4585: 
                   4586: =item * &determinedomain()
1.60      matthew  4587: 
                   4588: Inputs: $domain (usually will be undef)
                   4589: 
1.63      www      4590: Returns: Determines which domain should be used for designs
1.60      matthew  4591: 
                   4592: =cut
1.54      www      4593: 
1.60      matthew  4594: ###############################################
1.63      www      4595: sub determinedomain {
                   4596:     my $domain=shift;
1.531     albertel 4597:     if (! $domain) {
1.60      matthew  4598:         # Determine domain if we have not been given one
1.893     raeburn  4599:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4600:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4601:         if ($env{'request.role.domain'}) { 
                   4602:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4603:         }
                   4604:     }
1.63      www      4605:     return $domain;
                   4606: }
                   4607: ###############################################
1.517     raeburn  4608: 
1.518     albertel 4609: sub devalidate_domconfig_cache {
                   4610:     my ($udom)=@_;
                   4611:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4612: }
                   4613: 
                   4614: # ---------------------- Get domain configuration for a domain
                   4615: sub get_domainconf {
                   4616:     my ($udom) = @_;
                   4617:     my $cachetime=1800;
                   4618:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4619:     if (defined($cached)) { return %{$result}; }
                   4620: 
                   4621:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4622: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4623:     my (%designhash,%legacy);
1.518     albertel 4624:     if (keys(%domconfig) > 0) {
                   4625:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4626:             if (keys(%{$domconfig{'login'}})) {
                   4627:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4628:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4629:                         if ($key eq 'loginvia') {
                   4630:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4631:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4632:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4633:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4634:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4635:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4636:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4637: 
                   4638:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4639:                                             } else {
1.1013    raeburn  4640:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4641:                                             }
                   4642:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4643:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4644:                                             }
1.946     raeburn  4645:                                         }
                   4646:                                     }
                   4647:                                 }
                   4648:                             }
                   4649:                         } else {
                   4650:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4651:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4652:                                     $domconfig{'login'}{$key}{$img};
                   4653:                             }
1.699     raeburn  4654:                         }
                   4655:                     } else {
                   4656:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4657:                     }
1.632     raeburn  4658:                 }
                   4659:             } else {
                   4660:                 $legacy{'login'} = 1;
1.518     albertel 4661:             }
1.632     raeburn  4662:         } else {
                   4663:             $legacy{'login'} = 1;
1.518     albertel 4664:         }
                   4665:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4666:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4667:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4668:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4669:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4670:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4671:                         }
1.518     albertel 4672:                     }
                   4673:                 }
1.632     raeburn  4674:             } else {
                   4675:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4676:             }
1.632     raeburn  4677:         } else {
                   4678:             $legacy{'rolecolors'} = 1;
1.518     albertel 4679:         }
1.948     raeburn  4680:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4681:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4682:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4683:             }
                   4684:         }
1.632     raeburn  4685:         if (keys(%legacy) > 0) {
                   4686:             my %legacyhash = &get_legacy_domconf($udom);
                   4687:             foreach my $item (keys(%legacyhash)) {
                   4688:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4689:                     if ($legacy{'login'}) { 
                   4690:                         $designhash{$item} = $legacyhash{$item};
                   4691:                     }
                   4692:                 } else {
                   4693:                     if ($legacy{'rolecolors'}) {
                   4694:                         $designhash{$item} = $legacyhash{$item};
                   4695:                     }
1.518     albertel 4696:                 }
                   4697:             }
                   4698:         }
1.632     raeburn  4699:     } else {
                   4700:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4701:     }
                   4702:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4703: 				  $cachetime);
                   4704:     return %designhash;
                   4705: }
                   4706: 
1.632     raeburn  4707: sub get_legacy_domconf {
                   4708:     my ($udom) = @_;
                   4709:     my %legacyhash;
                   4710:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4711:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4712:     if (-e $designfile) {
                   4713:         if ( open (my $fh,"<$designfile") ) {
                   4714:             while (my $line = <$fh>) {
                   4715:                 next if ($line =~ /^\#/);
                   4716:                 chomp($line);
                   4717:                 my ($key,$val)=(split(/\=/,$line));
                   4718:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4719:             }
                   4720:             close($fh);
                   4721:         }
                   4722:     }
1.1026    raeburn  4723:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4724:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4725:     }
                   4726:     return %legacyhash;
                   4727: }
                   4728: 
1.63      www      4729: =pod
                   4730: 
1.112     bowersj2 4731: =item * &domainlogo()
1.63      www      4732: 
                   4733: Inputs: $domain (usually will be undef)
                   4734: 
                   4735: Returns: A link to a domain logo, if the domain logo exists.
                   4736: If the domain logo does not exist, a description of the domain.
                   4737: 
                   4738: =cut
1.112     bowersj2 4739: 
1.63      www      4740: ###############################################
                   4741: sub domainlogo {
1.517     raeburn  4742:     my $domain = &determinedomain(shift);
1.518     albertel 4743:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4744:     # See if there is a logo
                   4745:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4746:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4747:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4748: 	    if ($imgsrc =~ m{^/res/}) {
                   4749: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4750: 		&Apache::lonnet::repcopy($local_name);
                   4751: 	    }
                   4752: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4753:         } 
                   4754:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4755:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4756:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4757:     } else {
1.60      matthew  4758:         return '';
1.59      www      4759:     }
                   4760: }
1.63      www      4761: ##############################################
                   4762: 
                   4763: =pod
                   4764: 
1.112     bowersj2 4765: =item * &designparm()
1.63      www      4766: 
                   4767: Inputs: $which parameter; $domain (usually will be undef)
                   4768: 
                   4769: Returns: value of designparamter $which
                   4770: 
                   4771: =cut
1.112     bowersj2 4772: 
1.397     albertel 4773: 
1.400     albertel 4774: ##############################################
1.397     albertel 4775: sub designparm {
                   4776:     my ($which,$domain)=@_;
                   4777:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4778:         return $env{'environment.color.'.$which};
1.96      www      4779:     }
1.63      www      4780:     $domain=&determinedomain($domain);
1.1016    raeburn  4781:     my %domdesign;
                   4782:     unless ($domain eq 'public') {
                   4783:         %domdesign = &get_domainconf($domain);
                   4784:     }
1.520     raeburn  4785:     my $output;
1.517     raeburn  4786:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4787:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4788:     } else {
1.520     raeburn  4789:         $output = $defaultdesign{$which};
                   4790:     }
                   4791:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4792:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4793:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4794:             if ($output =~ m{^/res/}) {
                   4795:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4796:                 &Apache::lonnet::repcopy($local_name);
                   4797:             }
1.520     raeburn  4798:             $output = &lonhttpdurl($output);
                   4799:         }
1.63      www      4800:     }
1.520     raeburn  4801:     return $output;
1.63      www      4802: }
1.59      www      4803: 
1.822     bisitz   4804: ##############################################
                   4805: =pod
                   4806: 
1.832     bisitz   4807: =item * &authorspace()
                   4808: 
1.1028    raeburn  4809: Inputs: $url (usually will be undef).
1.832     bisitz   4810: 
1.1028    raeburn  4811: Returns: Path to Construction Space containing the resource or 
                   4812:          directory being viewed (or for which action is being taken). 
                   4813:          If $url is provided, and begins /priv/<domain>/<uname>
                   4814:          the path will be that portion of the $context argument.
                   4815:          Otherwise the path will be for the author space of the current
                   4816:          user when the current role is author, or for that of the 
                   4817:          co-author/assistant co-author space when the current role 
                   4818:          is co-author or assistant co-author.
1.832     bisitz   4819: 
                   4820: =cut
                   4821: 
                   4822: sub authorspace {
1.1028    raeburn  4823:     my ($url) = @_;
                   4824:     if ($url ne '') {
                   4825:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4826:            return $1;
                   4827:         }
                   4828:     }
1.832     bisitz   4829:     my $caname = '';
1.1024    www      4830:     my $cadom = '';
1.1028    raeburn  4831:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4832:         ($cadom,$caname) =
1.832     bisitz   4833:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4834:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4835:         $caname = $env{'user.name'};
1.1024    www      4836:         $cadom = $env{'user.domain'};
1.832     bisitz   4837:     }
1.1028    raeburn  4838:     if (($caname ne '') && ($cadom ne '')) {
                   4839:         return "/priv/$cadom/$caname/";
                   4840:     }
                   4841:     return;
1.832     bisitz   4842: }
                   4843: 
                   4844: ##############################################
                   4845: =pod
                   4846: 
1.822     bisitz   4847: =item * &head_subbox()
                   4848: 
                   4849: Inputs: $content (contains HTML code with page functions, etc.)
                   4850: 
                   4851: Returns: HTML div with $content
                   4852:          To be included in page header
                   4853: 
                   4854: =cut
                   4855: 
                   4856: sub head_subbox {
                   4857:     my ($content)=@_;
                   4858:     my $output =
1.993     raeburn  4859:         '<div class="LC_head_subbox">'
1.822     bisitz   4860:        .$content
                   4861:        .'</div>'
                   4862: }
                   4863: 
                   4864: ##############################################
                   4865: =pod
                   4866: 
                   4867: =item * &CSTR_pageheader()
                   4868: 
1.1026    raeburn  4869: Input: (optional) filename from which breadcrumb trail is built.
                   4870:        In most cases no input as needed, as $env{'request.filename'}
                   4871:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4872: 
                   4873: Returns: HTML div with CSTR path and recent box
                   4874:          To be included on Construction Space pages
                   4875: 
                   4876: =cut
                   4877: 
                   4878: sub CSTR_pageheader {
1.1026    raeburn  4879:     my ($trailfile) = @_;
                   4880:     if ($trailfile eq '') {
                   4881:         $trailfile = $env{'request.filename'};
                   4882:     }
                   4883: 
                   4884: # this is for resources; directories have customtitle, and crumbs
                   4885: # and select recent are created in lonpubdir.pm
                   4886: 
                   4887:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4888:     my ($udom,$uname,$thisdisfn)=
1.1026    raeburn  4889:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
                   4890:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4891:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4892: 
                   4893:     my $parentpath = '';
                   4894:     my $lastitem = '';
                   4895:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4896:         $parentpath = $1;
                   4897:         $lastitem = $2;
                   4898:     } else {
                   4899:         $lastitem = $thisdisfn;
                   4900:     }
1.921     bisitz   4901: 
                   4902:     my $output =
1.822     bisitz   4903:          '<div>'
                   4904:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4905:         .'<b>'.&mt('Construction Space:').'</b> '
                   4906:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4907:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4908:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4909: 
                   4910:     if ($lastitem) {
                   4911:         $output .=
                   4912:              '<span class="LC_filename">'
                   4913:             .$lastitem
                   4914:             .'</span>';
                   4915:     }
                   4916:     $output .=
                   4917:          '<br />'
1.822     bisitz   4918:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4919:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4920:         .'</form>'
                   4921:         .&Apache::lonmenu::constspaceform()
                   4922:         .'</div>';
1.921     bisitz   4923: 
                   4924:     return $output;
1.822     bisitz   4925: }
                   4926: 
1.60      matthew  4927: ###############################################
                   4928: ###############################################
                   4929: 
                   4930: =pod
                   4931: 
1.112     bowersj2 4932: =back
                   4933: 
1.549     albertel 4934: =head1 HTML Helpers
1.112     bowersj2 4935: 
                   4936: =over 4
                   4937: 
                   4938: =item * &bodytag()
1.60      matthew  4939: 
                   4940: Returns a uniform header for LON-CAPA web pages.
                   4941: 
                   4942: Inputs: 
                   4943: 
1.112     bowersj2 4944: =over 4
                   4945: 
                   4946: =item * $title, A title to be displayed on the page.
                   4947: 
                   4948: =item * $function, the current role (can be undef).
                   4949: 
                   4950: =item * $addentries, extra parameters for the <body> tag.
                   4951: 
                   4952: =item * $bodyonly, if defined, only return the <body> tag.
                   4953: 
                   4954: =item * $domain, if defined, force a given domain.
                   4955: 
                   4956: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4957:             text interface only)
1.60      matthew  4958: 
1.814     bisitz   4959: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4960:                      navigational links
1.317     albertel 4961: 
1.338     albertel 4962: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4963: 
1.1075.2.12  raeburn  4964: =item * $no_inline_link, if true and in remote mode, don't show the
                   4965:          'Switch To Inline Menu' link
                   4966: 
1.460     albertel 4967: =item * $args, optional argument valid values are
                   4968:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4969:             inherit_jsmath -> when creating popup window in a page,
                   4970:                               should it have jsmath forced on by the
                   4971:                               current page
1.460     albertel 4972: 
1.1075.2.15  raeburn  4973: =item * $advtoolsref, optional argument, ref to an array containing
                   4974:             inlineremote items to be added in "Functions" menu below
                   4975:             breadcrumbs.
                   4976: 
1.112     bowersj2 4977: =back
                   4978: 
1.60      matthew  4979: Returns: A uniform header for LON-CAPA web pages.  
                   4980: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4981: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4982: other decorations will be returned.
                   4983: 
                   4984: =cut
                   4985: 
1.54      www      4986: sub bodytag {
1.831     bisitz   4987:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  4988:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 4989: 
1.954     raeburn  4990:     my $public;
                   4991:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4992:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4993:         $public = 1;
                   4994:     }
1.460     albertel 4995:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4996: 
1.183     matthew  4997:     $function = &get_users_function() if (!$function);
1.339     albertel 4998:     my $img =    &designparm($function.'.img',$domain);
                   4999:     my $font =   &designparm($function.'.font',$domain);
                   5000:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5001: 
1.803     bisitz   5002:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5003: 		   'bgcolor' => $pgbg,
1.339     albertel 5004: 		   'text'    => $font,
                   5005:                    'alink'   => &designparm($function.'.alink',$domain),
                   5006: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5007: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5008:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5009: 
1.63      www      5010:  # role and realm
1.378     raeburn  5011:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5012:     if ($role  eq 'ca') {
1.479     albertel 5013:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5014:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5015:     } 
1.55      www      5016: # realm
1.258     albertel 5017:     if ($env{'request.course.id'}) {
1.378     raeburn  5018:         if ($env{'request.role'} !~ /^cr/) {
                   5019:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5020:         }
1.898     raeburn  5021:         if ($env{'request.course.sec'}) {
                   5022:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5023:         }   
1.359     albertel 5024: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5025:     } else {
                   5026:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5027:     }
1.433     albertel 5028: 
1.359     albertel 5029:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5030: 
1.438     albertel 5031:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5032: 
1.101     www      5033: # construct main body tag
1.359     albertel 5034:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5035: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5036: 
1.530     albertel 5037:     if ($bodyonly) {
1.60      matthew  5038:         return $bodytag;
1.798     tempelho 5039:     } 
1.359     albertel 5040: 
1.410     albertel 5041:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  5042:     if ($public) {
1.433     albertel 5043: 	undef($role);
1.434     albertel 5044:     } else {
1.1070    raeburn  5045: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5046:                                 undef,'LC_menubuttons_link');
1.433     albertel 5047:     }
1.359     albertel 5048:     
1.762     bisitz   5049:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5050:     #
                   5051:     # Extra info if you are the DC
                   5052:     my $dc_info = '';
                   5053:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5054:                         $env{'course.'.$env{'request.course.id'}.
                   5055:                                  '.domain'}.'/'})) {
                   5056:         my $cid = $env{'request.course.id'};
1.917     raeburn  5057:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5058:         $dc_info =~ s/\s+$//;
1.359     albertel 5059:     }
                   5060: 
1.898     raeburn  5061:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5062:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5063: 
1.1075.2.13  raeburn  5064:     if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   5065:         return $bodytag; 
                   5066:     }
1.903     droeschl 5067: 
1.1075.2.13  raeburn  5068:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5069: 
1.1075.2.21  raeburn  5070:     my $funclist;
                   5071:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
                   5072:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions(), 'start')."\n".
                   5073:                     Apache::lonmenu::serverform();
                   5074:         my $forbodytag;
                   5075:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5076:                                             $forcereg,$args->{'group'},
                   5077:                                             $args->{'bread_crumbs'},
                   5078:                                             $advtoolsref,'',\$forbodytag);
                   5079:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5080:             $funclist = $forbodytag;
                   5081:         }
                   5082:     } else {
1.903     droeschl 5083: 
                   5084:         #    if ($env{'request.state'} eq 'construct') {
                   5085:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5086:         #    }
                   5087: 
1.359     albertel 5088: 
1.1075.2.2  raeburn  5089: 
1.916     droeschl 5090:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5091:             if ($dc_info) {
                   5092:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5093:             }
1.1075.2.22  raeburn  5094:             $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   5095:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5096:             return $bodytag;
                   5097:         }
1.894     droeschl 5098: 
1.927     raeburn  5099:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   5100:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   5101:         }
1.916     droeschl 5102: 
1.903     droeschl 5103:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5104:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   5105: 
1.903     droeschl 5106:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 5107: 
1.917     raeburn  5108:         if ($dc_info) {
                   5109:             $dc_info = &dc_courseid_toggle($dc_info);
                   5110:         }
                   5111:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5112: 
1.903     droeschl 5113:         #don't show menus for public users
1.954     raeburn  5114:         if (!$public){
1.903     droeschl 5115:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5116:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5117:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5118:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5119:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5120:                                 $args->{'bread_crumbs'});
                   5121:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5122:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5123:                                                             $args->{'group'});
1.1075.2.15  raeburn  5124:             } else {
1.1075.2.21  raeburn  5125:                 my $forbodytag;
                   5126:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5127:                                                     $forcereg,$args->{'group'},
                   5128:                                                     $args->{'bread_crumbs'},
                   5129:                                                     $advtoolsref,'',\$forbodytag);
                   5130:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5131:                     $bodytag .= $forbodytag;
                   5132:                 }
1.920     raeburn  5133:             }
1.903     droeschl 5134:         }else{
                   5135:             # this is to seperate menu from content when there's no secondary
                   5136:             # menu. Especially needed for public accessible ressources.
                   5137:             $bodytag .= '<hr style="clear:both" />';
                   5138:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5139:         }
1.903     droeschl 5140: 
1.235     raeburn  5141:         return $bodytag;
1.1075.2.12  raeburn  5142:     }
                   5143: 
                   5144: #
                   5145: # Top frame rendering, Remote is up
                   5146: #
                   5147: 
                   5148:     my $imgsrc = $img;
                   5149:     if ($img =~ /^\/adm/) {
                   5150:         $imgsrc = &lonhttpdurl($img);
                   5151:     }
                   5152:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5153: 
                   5154:     # Explicit link to get inline menu
                   5155:     my $menu= ($no_inline_link?''
                   5156:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5157: 
                   5158:     if ($dc_info) {
                   5159:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5160:     }
                   5161: 
                   5162:     unless ($env{'form.inhibitmenu'}) {
                   5163:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
                   5164:                        <ol class="LC_primary_menu LC_right">
                   5165:                        <li>$menu</li>
                   5166:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5167:     }
1.1075.2.13  raeburn  5168:     if ($env{'request.state'} eq 'construct') {
                   5169:         if (!$public){
                   5170:             if ($env{'request.state'} eq 'construct') {
                   5171:                 $funclist = &Apache::lonhtmlcommon::scripttag(
                   5172:                                 &Apache::lonmenu::utilityfunctions(), 'start').
                   5173:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5174:                             &Apache::lonmenu::innerregister($forcereg,
                   5175:                                                             $args->{'bread_crumbs'});
                   5176:             }
                   5177:         }
                   5178:     }
1.1075.2.21  raeburn  5179:     return $bodytag."\n".$funclist;
1.182     matthew  5180: }
                   5181: 
1.917     raeburn  5182: sub dc_courseid_toggle {
                   5183:     my ($dc_info) = @_;
1.980     raeburn  5184:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5185:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5186:            &mt('(More ...)').'</a></span>'.
                   5187:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5188: }
                   5189: 
1.330     albertel 5190: sub make_attr_string {
                   5191:     my ($register,$attr_ref) = @_;
                   5192: 
                   5193:     if ($attr_ref && !ref($attr_ref)) {
                   5194: 	die("addentries Must be a hash ref ".
                   5195: 	    join(':',caller(1))." ".
                   5196: 	    join(':',caller(0))." ");
                   5197:     }
                   5198: 
                   5199:     if ($register) {
1.339     albertel 5200: 	my ($on_load,$on_unload);
                   5201: 	foreach my $key (keys(%{$attr_ref})) {
                   5202: 	    if      (lc($key) eq 'onload') {
                   5203: 		$on_load.=$attr_ref->{$key}.';';
                   5204: 		delete($attr_ref->{$key});
                   5205: 
                   5206: 	    } elsif (lc($key) eq 'onunload') {
                   5207: 		$on_unload.=$attr_ref->{$key}.';';
                   5208: 		delete($attr_ref->{$key});
                   5209: 	    }
                   5210: 	}
1.1075.2.12  raeburn  5211:         if ($env{'environment.remote'} eq 'on') {
                   5212:             $attr_ref->{'onload'}  =
                   5213:                 &Apache::lonmenu::loadevents().  $on_load;
                   5214:             $attr_ref->{'onunload'}=
                   5215:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5216:         } else {  
                   5217: 	    $attr_ref->{'onload'}  = $on_load;
                   5218: 	    $attr_ref->{'onunload'}= $on_unload;
                   5219:         }
1.330     albertel 5220:     }
1.339     albertel 5221: 
1.330     albertel 5222:     my $attr_string;
                   5223:     foreach my $attr (keys(%$attr_ref)) {
                   5224: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5225:     }
                   5226:     return $attr_string;
                   5227: }
                   5228: 
                   5229: 
1.182     matthew  5230: ###############################################
1.251     albertel 5231: ###############################################
                   5232: 
                   5233: =pod
                   5234: 
                   5235: =item * &endbodytag()
                   5236: 
                   5237: Returns a uniform footer for LON-CAPA web pages.
                   5238: 
1.635     raeburn  5239: Inputs: 1 - optional reference to an args hash
                   5240: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5241: a 'Continue' link is not displayed if the page contains an
                   5242: internal redirect in the <head></head> section,
                   5243: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5244: 
                   5245: =cut
                   5246: 
                   5247: sub endbodytag {
1.635     raeburn  5248:     my ($args) = @_;
1.1075.2.6  raeburn  5249:     my $endbodytag;
                   5250:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5251:         $endbodytag='</body>';
                   5252:     }
1.269     albertel 5253:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5254:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5255:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5256: 	    $endbodytag=
                   5257: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5258: 	        &mt('Continue').'</a>'.
                   5259: 	        $endbodytag;
                   5260:         }
1.315     albertel 5261:     }
1.251     albertel 5262:     return $endbodytag;
                   5263: }
                   5264: 
1.352     albertel 5265: =pod
                   5266: 
                   5267: =item * &standard_css()
                   5268: 
                   5269: Returns a style sheet
                   5270: 
                   5271: Inputs: (all optional)
                   5272:             domain         -> force to color decorate a page for a specific
                   5273:                                domain
                   5274:             function       -> force usage of a specific rolish color scheme
                   5275:             bgcolor        -> override the default page bgcolor
                   5276: 
                   5277: =cut
                   5278: 
1.343     albertel 5279: sub standard_css {
1.345     albertel 5280:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5281:     $function  = &get_users_function() if (!$function);
                   5282:     my $img    = &designparm($function.'.img',   $domain);
                   5283:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5284:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5285:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5286: #second colour for later usage
1.345     albertel 5287:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5288:     my $pgbg_or_bgcolor =
                   5289: 	         $bgcolor ||
1.352     albertel 5290: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5291:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5292:     my $alink  = &designparm($function.'.alink', $domain);
                   5293:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5294:     my $link   = &designparm($function.'.link',  $domain);
                   5295: 
1.602     albertel 5296:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5297:     my $mono                 = 'monospace';
1.850     bisitz   5298:     my $data_table_head      = $sidebg;
                   5299:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5300:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5301:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5302:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5303:     my $mail_new             = '#FFBB77';
                   5304:     my $mail_new_hover       = '#DD9955';
                   5305:     my $mail_read            = '#BBBB77';
                   5306:     my $mail_read_hover      = '#999944';
                   5307:     my $mail_replied         = '#AAAA88';
                   5308:     my $mail_replied_hover   = '#888855';
                   5309:     my $mail_other           = '#99BBBB';
                   5310:     my $mail_other_hover     = '#669999';
1.391     albertel 5311:     my $table_header         = '#DDDDDD';
1.489     raeburn  5312:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5313:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5314:     my $button_hover         = '#BF2317';
1.392     albertel 5315: 
1.608     albertel 5316:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5317:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5318:                                              : '0 3px 0 4px';
1.448     albertel 5319: 
1.523     albertel 5320: 
1.343     albertel 5321:     return <<END;
1.947     droeschl 5322: 
                   5323: /* needed for iframe to allow 100% height in FF */
                   5324: body, html { 
                   5325:     margin: 0;
                   5326:     padding: 0 0.5%;
                   5327:     height: 99%; /* to avoid scrollbars */
                   5328: }
                   5329: 
1.795     www      5330: body {
1.911     bisitz   5331:   font-family: $sans;
                   5332:   line-height:130%;
                   5333:   font-size:0.83em;
                   5334:   color:$font;
1.795     www      5335: }
                   5336: 
1.959     onken    5337: a:focus,
                   5338: a:focus img {
1.795     www      5339:   color: red;
                   5340: }
1.698     harmsja  5341: 
1.911     bisitz   5342: form, .inline {
                   5343:   display: inline;
1.795     www      5344: }
1.721     harmsja  5345: 
1.795     www      5346: .LC_right {
1.911     bisitz   5347:   text-align:right;
1.795     www      5348: }
                   5349: 
                   5350: .LC_middle {
1.911     bisitz   5351:   vertical-align:middle;
1.795     www      5352: }
1.721     harmsja  5353: 
1.911     bisitz   5354: .LC_400Box {
                   5355:   width:400px;
                   5356: }
1.721     harmsja  5357: 
1.947     droeschl 5358: .LC_iframecontainer {
                   5359:     width: 98%;
                   5360:     margin: 0;
                   5361:     position: fixed;
                   5362:     top: 8.5em;
                   5363:     bottom: 0;
                   5364: }
                   5365: 
                   5366: .LC_iframecontainer iframe{
                   5367:     border: none;
                   5368:     width: 100%;
                   5369:     height: 100%;
                   5370: }
                   5371: 
1.778     bisitz   5372: .LC_filename {
                   5373:   font-family: $mono;
                   5374:   white-space:pre;
1.921     bisitz   5375:   font-size: 120%;
1.778     bisitz   5376: }
                   5377: 
                   5378: .LC_fileicon {
                   5379:   border: none;
                   5380:   height: 1.3em;
                   5381:   vertical-align: text-bottom;
                   5382:   margin-right: 0.3em;
                   5383:   text-decoration:none;
                   5384: }
                   5385: 
1.1008    www      5386: .LC_setting {
                   5387:   text-decoration:underline;
                   5388: }
                   5389: 
1.350     albertel 5390: .LC_error {
                   5391:   color: red;
                   5392: }
1.795     www      5393: 
1.1075.2.15  raeburn  5394: .LC_warning {
                   5395:   color: darkorange;
                   5396: }
                   5397: 
1.457     albertel 5398: .LC_diff_removed {
1.733     bisitz   5399:   color: red;
1.394     albertel 5400: }
1.532     albertel 5401: 
                   5402: .LC_info,
1.457     albertel 5403: .LC_success,
                   5404: .LC_diff_added {
1.350     albertel 5405:   color: green;
                   5406: }
1.795     www      5407: 
1.802     bisitz   5408: div.LC_confirm_box {
                   5409:   background-color: #FAFAFA;
                   5410:   border: 1px solid $lg_border_color;
                   5411:   margin-right: 0;
                   5412:   padding: 5px;
                   5413: }
                   5414: 
                   5415: div.LC_confirm_box .LC_error img,
                   5416: div.LC_confirm_box .LC_success img {
                   5417:   vertical-align: middle;
                   5418: }
                   5419: 
1.440     albertel 5420: .LC_icon {
1.771     droeschl 5421:   border: none;
1.790     droeschl 5422:   vertical-align: middle;
1.771     droeschl 5423: }
                   5424: 
1.543     albertel 5425: .LC_docs_spacer {
                   5426:   width: 25px;
                   5427:   height: 1px;
1.771     droeschl 5428:   border: none;
1.543     albertel 5429: }
1.346     albertel 5430: 
1.532     albertel 5431: .LC_internal_info {
1.735     bisitz   5432:   color: #999999;
1.532     albertel 5433: }
                   5434: 
1.794     www      5435: .LC_discussion {
1.1050    www      5436:   background: $data_table_dark;
1.911     bisitz   5437:   border: 1px solid black;
                   5438:   margin: 2px;
1.794     www      5439: }
                   5440: 
                   5441: .LC_disc_action_left {
1.1050    www      5442:   background: $sidebg;
1.911     bisitz   5443:   text-align: left;
1.1050    www      5444:   padding: 4px;
                   5445:   margin: 2px;
1.794     www      5446: }
                   5447: 
                   5448: .LC_disc_action_right {
1.1050    www      5449:   background: $sidebg;
1.911     bisitz   5450:   text-align: right;
1.1050    www      5451:   padding: 4px;
                   5452:   margin: 2px;
1.794     www      5453: }
                   5454: 
                   5455: .LC_disc_new_item {
1.911     bisitz   5456:   background: white;
                   5457:   border: 2px solid red;
1.1050    www      5458:   margin: 4px;
                   5459:   padding: 4px;
1.794     www      5460: }
                   5461: 
                   5462: .LC_disc_old_item {
1.911     bisitz   5463:   background: white;
1.1050    www      5464:   margin: 4px;
                   5465:   padding: 4px;
1.794     www      5466: }
                   5467: 
1.458     albertel 5468: table.LC_pastsubmission {
                   5469:   border: 1px solid black;
                   5470:   margin: 2px;
                   5471: }
                   5472: 
1.924     bisitz   5473: table#LC_menubuttons {
1.345     albertel 5474:   width: 100%;
                   5475:   background: $pgbg;
1.392     albertel 5476:   border: 2px;
1.402     albertel 5477:   border-collapse: separate;
1.803     bisitz   5478:   padding: 0;
1.345     albertel 5479: }
1.392     albertel 5480: 
1.801     tempelho 5481: table#LC_title_bar a {
                   5482:   color: $fontmenu;
                   5483: }
1.836     bisitz   5484: 
1.807     droeschl 5485: table#LC_title_bar {
1.819     tempelho 5486:   clear: both;
1.836     bisitz   5487:   display: none;
1.807     droeschl 5488: }
                   5489: 
1.795     www      5490: table#LC_title_bar,
1.933     droeschl 5491: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5492: table#LC_title_bar.LC_with_remote {
1.359     albertel 5493:   width: 100%;
1.392     albertel 5494:   border-color: $pgbg;
                   5495:   border-style: solid;
                   5496:   border-width: $border;
1.379     albertel 5497:   background: $pgbg;
1.801     tempelho 5498:   color: $fontmenu;
1.392     albertel 5499:   border-collapse: collapse;
1.803     bisitz   5500:   padding: 0;
1.819     tempelho 5501:   margin: 0;
1.359     albertel 5502: }
1.795     www      5503: 
1.933     droeschl 5504: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5505:     margin: 0;
                   5506:     padding: 0;
1.933     droeschl 5507:     position: relative;
                   5508:     list-style: none;
1.913     droeschl 5509: }
1.933     droeschl 5510: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5511:     display: inline;
                   5512: }
1.933     droeschl 5513: 
                   5514: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5515:     padding: 0;
1.933     droeschl 5516:     margin: 0;
                   5517:     float: left;
1.913     droeschl 5518: }
1.933     droeschl 5519: .LC_breadcrumb_tools_tools {
                   5520:     padding: 0;
                   5521:     margin: 0;
1.913     droeschl 5522:     float: right;
                   5523: }
                   5524: 
1.359     albertel 5525: table#LC_title_bar td {
                   5526:   background: $tabbg;
                   5527: }
1.795     www      5528: 
1.911     bisitz   5529: table#LC_menubuttons img {
1.803     bisitz   5530:   border: none;
1.346     albertel 5531: }
1.795     www      5532: 
1.842     droeschl 5533: .LC_breadcrumbs_component {
1.911     bisitz   5534:   float: right;
                   5535:   margin: 0 1em;
1.357     albertel 5536: }
1.842     droeschl 5537: .LC_breadcrumbs_component img {
1.911     bisitz   5538:   vertical-align: middle;
1.777     tempelho 5539: }
1.795     www      5540: 
1.383     albertel 5541: td.LC_table_cell_checkbox {
                   5542:   text-align: center;
                   5543: }
1.795     www      5544: 
                   5545: .LC_fontsize_small {
1.911     bisitz   5546:   font-size: 70%;
1.705     tempelho 5547: }
                   5548: 
1.844     bisitz   5549: #LC_breadcrumbs {
1.911     bisitz   5550:   clear:both;
                   5551:   background: $sidebg;
                   5552:   border-bottom: 1px solid $lg_border_color;
                   5553:   line-height: 2.5em;
1.933     droeschl 5554:   overflow: hidden;
1.911     bisitz   5555:   margin: 0;
                   5556:   padding: 0;
1.995     raeburn  5557:   text-align: left;
1.819     tempelho 5558: }
1.862     bisitz   5559: 
1.1075.2.16  raeburn  5560: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5561:   clear:both;
                   5562:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5563:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5564:   margin: 0 0 10px 0;
1.966     bisitz   5565:   padding: 3px;
1.995     raeburn  5566:   text-align: left;
1.822     bisitz   5567: }
                   5568: 
1.795     www      5569: .LC_fontsize_medium {
1.911     bisitz   5570:   font-size: 85%;
1.705     tempelho 5571: }
                   5572: 
1.795     www      5573: .LC_fontsize_large {
1.911     bisitz   5574:   font-size: 120%;
1.705     tempelho 5575: }
                   5576: 
1.346     albertel 5577: .LC_menubuttons_inline_text {
                   5578:   color: $font;
1.698     harmsja  5579:   font-size: 90%;
1.701     harmsja  5580:   padding-left:3px;
1.346     albertel 5581: }
                   5582: 
1.934     droeschl 5583: .LC_menubuttons_inline_text img{
                   5584:   vertical-align: middle;
                   5585: }
                   5586: 
1.1051    www      5587: li.LC_menubuttons_inline_text img {
1.951     onken    5588:   cursor:pointer;
1.1002    droeschl 5589:   text-decoration: none;
1.951     onken    5590: }
                   5591: 
1.526     www      5592: .LC_menubuttons_link {
                   5593:   text-decoration: none;
                   5594: }
1.795     www      5595: 
1.522     albertel 5596: .LC_menubuttons_category {
1.521     www      5597:   color: $font;
1.526     www      5598:   background: $pgbg;
1.521     www      5599:   font-size: larger;
                   5600:   font-weight: bold;
                   5601: }
                   5602: 
1.346     albertel 5603: td.LC_menubuttons_text {
1.911     bisitz   5604:   color: $font;
1.346     albertel 5605: }
1.706     harmsja  5606: 
1.346     albertel 5607: .LC_current_location {
                   5608:   background: $tabbg;
                   5609: }
1.795     www      5610: 
1.938     bisitz   5611: table.LC_data_table {
1.347     albertel 5612:   border: 1px solid #000000;
1.402     albertel 5613:   border-collapse: separate;
1.426     albertel 5614:   border-spacing: 1px;
1.610     albertel 5615:   background: $pgbg;
1.347     albertel 5616: }
1.795     www      5617: 
1.422     albertel 5618: .LC_data_table_dense {
                   5619:   font-size: small;
                   5620: }
1.795     www      5621: 
1.507     raeburn  5622: table.LC_nested_outer {
                   5623:   border: 1px solid #000000;
1.589     raeburn  5624:   border-collapse: collapse;
1.803     bisitz   5625:   border-spacing: 0;
1.507     raeburn  5626:   width: 100%;
                   5627: }
1.795     www      5628: 
1.879     raeburn  5629: table.LC_innerpickbox,
1.507     raeburn  5630: table.LC_nested {
1.803     bisitz   5631:   border: none;
1.589     raeburn  5632:   border-collapse: collapse;
1.803     bisitz   5633:   border-spacing: 0;
1.507     raeburn  5634:   width: 100%;
                   5635: }
1.795     www      5636: 
1.911     bisitz   5637: table.LC_data_table tr th,
                   5638: table.LC_calendar tr th,
1.879     raeburn  5639: table.LC_prior_tries tr th,
                   5640: table.LC_innerpickbox tr th {
1.349     albertel 5641:   font-weight: bold;
                   5642:   background-color: $data_table_head;
1.801     tempelho 5643:   color:$fontmenu;
1.701     harmsja  5644:   font-size:90%;
1.347     albertel 5645: }
1.795     www      5646: 
1.879     raeburn  5647: table.LC_innerpickbox tr th,
                   5648: table.LC_innerpickbox tr td {
                   5649:   vertical-align: top;
                   5650: }
                   5651: 
1.711     raeburn  5652: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5653:   background-color: #CCCCCC;
1.711     raeburn  5654:   font-weight: bold;
                   5655:   text-align: left;
                   5656: }
1.795     www      5657: 
1.912     bisitz   5658: table.LC_data_table tr.LC_odd_row > td {
                   5659:   background-color: $data_table_light;
                   5660:   padding: 2px;
                   5661:   vertical-align: top;
                   5662: }
                   5663: 
1.809     bisitz   5664: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5665:   background-color: $data_table_light;
1.912     bisitz   5666:   vertical-align: top;
                   5667: }
                   5668: 
                   5669: table.LC_data_table tr.LC_even_row > td {
                   5670:   background-color: $data_table_dark;
1.425     albertel 5671:   padding: 2px;
1.900     bisitz   5672:   vertical-align: top;
1.347     albertel 5673: }
1.795     www      5674: 
1.809     bisitz   5675: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5676:   background-color: $data_table_dark;
1.900     bisitz   5677:   vertical-align: top;
1.347     albertel 5678: }
1.795     www      5679: 
1.425     albertel 5680: table.LC_data_table tr.LC_data_table_highlight td {
                   5681:   background-color: $data_table_darker;
                   5682: }
1.795     www      5683: 
1.639     raeburn  5684: table.LC_data_table tr td.LC_leftcol_header {
                   5685:   background-color: $data_table_head;
                   5686:   font-weight: bold;
                   5687: }
1.795     www      5688: 
1.451     albertel 5689: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5690: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5691:   font-weight: bold;
                   5692:   font-style: italic;
                   5693:   text-align: center;
                   5694:   padding: 8px;
1.347     albertel 5695: }
1.795     www      5696: 
1.940     bisitz   5697: table.LC_data_table tr.LC_empty_row td {
                   5698:   background-color: $sidebg;
                   5699: }
                   5700: 
                   5701: table.LC_nested tr.LC_empty_row td {
                   5702:   background-color: #FFFFFF;
                   5703: }
                   5704: 
1.890     droeschl 5705: table.LC_caption {
                   5706: }
                   5707: 
1.507     raeburn  5708: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5709:   padding: 4ex
                   5710: }
1.795     www      5711: 
1.507     raeburn  5712: table.LC_nested_outer tr th {
                   5713:   font-weight: bold;
1.801     tempelho 5714:   color:$fontmenu;
1.507     raeburn  5715:   background-color: $data_table_head;
1.701     harmsja  5716:   font-size: small;
1.507     raeburn  5717:   border-bottom: 1px solid #000000;
                   5718: }
1.795     www      5719: 
1.507     raeburn  5720: table.LC_nested_outer tr td.LC_subheader {
                   5721:   background-color: $data_table_head;
                   5722:   font-weight: bold;
                   5723:   font-size: small;
                   5724:   border-bottom: 1px solid #000000;
                   5725:   text-align: right;
1.451     albertel 5726: }
1.795     www      5727: 
1.507     raeburn  5728: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5729:   background-color: #CCCCCC;
1.451     albertel 5730:   font-weight: bold;
                   5731:   font-size: small;
1.507     raeburn  5732:   text-align: center;
                   5733: }
1.795     www      5734: 
1.589     raeburn  5735: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5736: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5737:   text-align: left;
1.451     albertel 5738: }
1.795     www      5739: 
1.507     raeburn  5740: table.LC_nested td {
1.735     bisitz   5741:   background-color: #FFFFFF;
1.451     albertel 5742:   font-size: small;
1.507     raeburn  5743: }
1.795     www      5744: 
1.507     raeburn  5745: table.LC_nested_outer tr th.LC_right_item,
                   5746: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5747: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5748: table.LC_nested tr td.LC_right_item {
1.451     albertel 5749:   text-align: right;
                   5750: }
                   5751: 
1.507     raeburn  5752: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5753:   background-color: #EEEEEE;
1.451     albertel 5754: }
                   5755: 
1.473     raeburn  5756: table.LC_createuser {
                   5757: }
                   5758: 
                   5759: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5760:   font-size: small;
1.473     raeburn  5761: }
                   5762: 
                   5763: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5764:   background-color: #CCCCCC;
1.473     raeburn  5765:   font-weight: bold;
                   5766:   text-align: center;
                   5767: }
                   5768: 
1.349     albertel 5769: table.LC_calendar {
                   5770:   border: 1px solid #000000;
                   5771:   border-collapse: collapse;
1.917     raeburn  5772:   width: 98%;
1.349     albertel 5773: }
1.795     www      5774: 
1.349     albertel 5775: table.LC_calendar_pickdate {
                   5776:   font-size: xx-small;
                   5777: }
1.795     www      5778: 
1.349     albertel 5779: table.LC_calendar tr td {
                   5780:   border: 1px solid #000000;
                   5781:   vertical-align: top;
1.917     raeburn  5782:   width: 14%;
1.349     albertel 5783: }
1.795     www      5784: 
1.349     albertel 5785: table.LC_calendar tr td.LC_calendar_day_empty {
                   5786:   background-color: $data_table_dark;
                   5787: }
1.795     www      5788: 
1.779     bisitz   5789: table.LC_calendar tr td.LC_calendar_day_current {
                   5790:   background-color: $data_table_highlight;
1.777     tempelho 5791: }
1.795     www      5792: 
1.938     bisitz   5793: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5794:   background-color: $mail_new;
                   5795: }
1.795     www      5796: 
1.938     bisitz   5797: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5798:   background-color: $mail_new_hover;
                   5799: }
1.795     www      5800: 
1.938     bisitz   5801: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5802:   background-color: $mail_read;
                   5803: }
1.795     www      5804: 
1.938     bisitz   5805: /*
                   5806: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5807:   background-color: $mail_read_hover;
                   5808: }
1.938     bisitz   5809: */
1.795     www      5810: 
1.938     bisitz   5811: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5812:   background-color: $mail_replied;
                   5813: }
1.795     www      5814: 
1.938     bisitz   5815: /*
                   5816: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5817:   background-color: $mail_replied_hover;
                   5818: }
1.938     bisitz   5819: */
1.795     www      5820: 
1.938     bisitz   5821: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5822:   background-color: $mail_other;
                   5823: }
1.795     www      5824: 
1.938     bisitz   5825: /*
                   5826: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5827:   background-color: $mail_other_hover;
                   5828: }
1.938     bisitz   5829: */
1.494     raeburn  5830: 
1.777     tempelho 5831: table.LC_data_table tr > td.LC_browser_file,
                   5832: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5833:   background: #AAEE77;
1.389     albertel 5834: }
1.795     www      5835: 
1.777     tempelho 5836: table.LC_data_table tr > td.LC_browser_file_locked,
                   5837: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5838:   background: #FFAA99;
1.387     albertel 5839: }
1.795     www      5840: 
1.777     tempelho 5841: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5842:   background: #888888;
1.779     bisitz   5843: }
1.795     www      5844: 
1.777     tempelho 5845: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5846: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5847:   background: #F8F866;
1.777     tempelho 5848: }
1.795     www      5849: 
1.696     bisitz   5850: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5851:   background: #E0E8FF;
1.387     albertel 5852: }
1.696     bisitz   5853: 
1.707     bisitz   5854: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5855:   /* background: #77FF77; */
1.707     bisitz   5856: }
1.795     www      5857: 
1.707     bisitz   5858: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5859:   border-right: 8px solid #FFFF77;
1.707     bisitz   5860: }
1.795     www      5861: 
1.707     bisitz   5862: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5863:   border-right: 8px solid #FFAA77;
1.707     bisitz   5864: }
1.795     www      5865: 
1.707     bisitz   5866: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5867:   border-right: 8px solid #FF7777;
1.707     bisitz   5868: }
1.795     www      5869: 
1.707     bisitz   5870: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5871:   border-right: 8px solid #AAFF77;
1.707     bisitz   5872: }
1.795     www      5873: 
1.707     bisitz   5874: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5875:   border-right: 8px solid #11CC55;
1.707     bisitz   5876: }
                   5877: 
1.388     albertel 5878: span.LC_current_location {
1.701     harmsja  5879:   font-size:larger;
1.388     albertel 5880:   background: $pgbg;
                   5881: }
1.387     albertel 5882: 
1.1029    www      5883: span.LC_current_nav_location {
                   5884:   font-weight:bold;
                   5885:   background: $sidebg;
                   5886: }
                   5887: 
1.395     albertel 5888: span.LC_parm_menu_item {
                   5889:   font-size: larger;
                   5890: }
1.795     www      5891: 
1.395     albertel 5892: span.LC_parm_scope_all {
                   5893:   color: red;
                   5894: }
1.795     www      5895: 
1.395     albertel 5896: span.LC_parm_scope_folder {
                   5897:   color: green;
                   5898: }
1.795     www      5899: 
1.395     albertel 5900: span.LC_parm_scope_resource {
                   5901:   color: orange;
                   5902: }
1.795     www      5903: 
1.395     albertel 5904: span.LC_parm_part {
                   5905:   color: blue;
                   5906: }
1.795     www      5907: 
1.911     bisitz   5908: span.LC_parm_folder,
                   5909: span.LC_parm_symb {
1.395     albertel 5910:   font-size: x-small;
                   5911:   font-family: $mono;
                   5912:   color: #AAAAAA;
                   5913: }
                   5914: 
1.977     bisitz   5915: ul.LC_parm_parmlist li {
                   5916:   display: inline-block;
                   5917:   padding: 0.3em 0.8em;
                   5918:   vertical-align: top;
                   5919:   width: 150px;
                   5920:   border-top:1px solid $lg_border_color;
                   5921: }
                   5922: 
1.795     www      5923: td.LC_parm_overview_level_menu,
                   5924: td.LC_parm_overview_map_menu,
                   5925: td.LC_parm_overview_parm_selectors,
                   5926: td.LC_parm_overview_restrictions  {
1.396     albertel 5927:   border: 1px solid black;
                   5928:   border-collapse: collapse;
                   5929: }
1.795     www      5930: 
1.396     albertel 5931: table.LC_parm_overview_restrictions td {
                   5932:   border-width: 1px 4px 1px 4px;
                   5933:   border-style: solid;
                   5934:   border-color: $pgbg;
                   5935:   text-align: center;
                   5936: }
1.795     www      5937: 
1.396     albertel 5938: table.LC_parm_overview_restrictions th {
                   5939:   background: $tabbg;
                   5940:   border-width: 1px 4px 1px 4px;
                   5941:   border-style: solid;
                   5942:   border-color: $pgbg;
                   5943: }
1.795     www      5944: 
1.398     albertel 5945: table#LC_helpmenu {
1.803     bisitz   5946:   border: none;
1.398     albertel 5947:   height: 55px;
1.803     bisitz   5948:   border-spacing: 0;
1.398     albertel 5949: }
                   5950: 
                   5951: table#LC_helpmenu fieldset legend {
                   5952:   font-size: larger;
                   5953: }
1.795     www      5954: 
1.397     albertel 5955: table#LC_helpmenu_links {
                   5956:   width: 100%;
                   5957:   border: 1px solid black;
                   5958:   background: $pgbg;
1.803     bisitz   5959:   padding: 0;
1.397     albertel 5960:   border-spacing: 1px;
                   5961: }
1.795     www      5962: 
1.397     albertel 5963: table#LC_helpmenu_links tr td {
                   5964:   padding: 1px;
                   5965:   background: $tabbg;
1.399     albertel 5966:   text-align: center;
                   5967:   font-weight: bold;
1.397     albertel 5968: }
1.396     albertel 5969: 
1.795     www      5970: table#LC_helpmenu_links a:link,
                   5971: table#LC_helpmenu_links a:visited,
1.397     albertel 5972: table#LC_helpmenu_links a:active {
                   5973:   text-decoration: none;
                   5974:   color: $font;
                   5975: }
1.795     www      5976: 
1.397     albertel 5977: table#LC_helpmenu_links a:hover {
                   5978:   text-decoration: underline;
                   5979:   color: $vlink;
                   5980: }
1.396     albertel 5981: 
1.417     albertel 5982: .LC_chrt_popup_exists {
                   5983:   border: 1px solid #339933;
                   5984:   margin: -1px;
                   5985: }
1.795     www      5986: 
1.417     albertel 5987: .LC_chrt_popup_up {
                   5988:   border: 1px solid yellow;
                   5989:   margin: -1px;
                   5990: }
1.795     www      5991: 
1.417     albertel 5992: .LC_chrt_popup {
                   5993:   border: 1px solid #8888FF;
                   5994:   background: #CCCCFF;
                   5995: }
1.795     www      5996: 
1.421     albertel 5997: table.LC_pick_box {
                   5998:   border-collapse: separate;
                   5999:   background: white;
                   6000:   border: 1px solid black;
                   6001:   border-spacing: 1px;
                   6002: }
1.795     www      6003: 
1.421     albertel 6004: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6005:   background: $sidebg;
1.421     albertel 6006:   font-weight: bold;
1.900     bisitz   6007:   text-align: left;
1.740     bisitz   6008:   vertical-align: top;
1.421     albertel 6009:   width: 184px;
                   6010:   padding: 8px;
                   6011: }
1.795     www      6012: 
1.579     raeburn  6013: table.LC_pick_box td.LC_pick_box_value {
                   6014:   text-align: left;
                   6015:   padding: 8px;
                   6016: }
1.795     www      6017: 
1.579     raeburn  6018: table.LC_pick_box td.LC_pick_box_select {
                   6019:   text-align: left;
                   6020:   padding: 8px;
                   6021: }
1.795     www      6022: 
1.424     albertel 6023: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6024:   padding: 0;
1.421     albertel 6025:   height: 1px;
                   6026:   background: black;
                   6027: }
1.795     www      6028: 
1.421     albertel 6029: table.LC_pick_box td.LC_pick_box_submit {
                   6030:   text-align: right;
                   6031: }
1.795     www      6032: 
1.579     raeburn  6033: table.LC_pick_box td.LC_evenrow_value {
                   6034:   text-align: left;
                   6035:   padding: 8px;
                   6036:   background-color: $data_table_light;
                   6037: }
1.795     www      6038: 
1.579     raeburn  6039: table.LC_pick_box td.LC_oddrow_value {
                   6040:   text-align: left;
                   6041:   padding: 8px;
                   6042:   background-color: $data_table_light;
                   6043: }
1.795     www      6044: 
1.579     raeburn  6045: span.LC_helpform_receipt_cat {
                   6046:   font-weight: bold;
                   6047: }
1.795     www      6048: 
1.424     albertel 6049: table.LC_group_priv_box {
                   6050:   background: white;
                   6051:   border: 1px solid black;
                   6052:   border-spacing: 1px;
                   6053: }
1.795     www      6054: 
1.424     albertel 6055: table.LC_group_priv_box td.LC_pick_box_title {
                   6056:   background: $tabbg;
                   6057:   font-weight: bold;
                   6058:   text-align: right;
                   6059:   width: 184px;
                   6060: }
1.795     www      6061: 
1.424     albertel 6062: table.LC_group_priv_box td.LC_groups_fixed {
                   6063:   background: $data_table_light;
                   6064:   text-align: center;
                   6065: }
1.795     www      6066: 
1.424     albertel 6067: table.LC_group_priv_box td.LC_groups_optional {
                   6068:   background: $data_table_dark;
                   6069:   text-align: center;
                   6070: }
1.795     www      6071: 
1.424     albertel 6072: table.LC_group_priv_box td.LC_groups_functionality {
                   6073:   background: $data_table_darker;
                   6074:   text-align: center;
                   6075:   font-weight: bold;
                   6076: }
1.795     www      6077: 
1.424     albertel 6078: table.LC_group_priv td {
                   6079:   text-align: left;
1.803     bisitz   6080:   padding: 0;
1.424     albertel 6081: }
                   6082: 
                   6083: .LC_navbuttons {
                   6084:   margin: 2ex 0ex 2ex 0ex;
                   6085: }
1.795     www      6086: 
1.423     albertel 6087: .LC_topic_bar {
                   6088:   font-weight: bold;
                   6089:   background: $tabbg;
1.918     wenzelju 6090:   margin: 1em 0em 1em 2em;
1.805     bisitz   6091:   padding: 3px;
1.918     wenzelju 6092:   font-size: 1.2em;
1.423     albertel 6093: }
1.795     www      6094: 
1.423     albertel 6095: .LC_topic_bar span {
1.918     wenzelju 6096:   left: 0.5em;
                   6097:   position: absolute;
1.423     albertel 6098:   vertical-align: middle;
1.918     wenzelju 6099:   font-size: 1.2em;
1.423     albertel 6100: }
1.795     www      6101: 
1.423     albertel 6102: table.LC_course_group_status {
                   6103:   margin: 20px;
                   6104: }
1.795     www      6105: 
1.423     albertel 6106: table.LC_status_selector td {
                   6107:   vertical-align: top;
                   6108:   text-align: center;
1.424     albertel 6109:   padding: 4px;
                   6110: }
1.795     www      6111: 
1.599     albertel 6112: div.LC_feedback_link {
1.616     albertel 6113:   clear: both;
1.829     kalberla 6114:   background: $sidebg;
1.779     bisitz   6115:   width: 100%;
1.829     kalberla 6116:   padding-bottom: 10px;
                   6117:   border: 1px $tabbg solid;
1.833     kalberla 6118:   height: 22px;
                   6119:   line-height: 22px;
                   6120:   padding-top: 5px;
                   6121: }
                   6122: 
                   6123: div.LC_feedback_link img {
                   6124:   height: 22px;
1.867     kalberla 6125:   vertical-align:middle;
1.829     kalberla 6126: }
                   6127: 
1.911     bisitz   6128: div.LC_feedback_link a {
1.829     kalberla 6129:   text-decoration: none;
1.489     raeburn  6130: }
1.795     www      6131: 
1.867     kalberla 6132: div.LC_comblock {
1.911     bisitz   6133:   display:inline;
1.867     kalberla 6134:   color:$font;
                   6135:   font-size:90%;
                   6136: }
                   6137: 
                   6138: div.LC_feedback_link div.LC_comblock {
                   6139:   padding-left:5px;
                   6140: }
                   6141: 
                   6142: div.LC_feedback_link div.LC_comblock a {
                   6143:   color:$font;
                   6144: }
                   6145: 
1.489     raeburn  6146: span.LC_feedback_link {
1.858     bisitz   6147:   /* background: $feedback_link_bg; */
1.599     albertel 6148:   font-size: larger;
                   6149: }
1.795     www      6150: 
1.599     albertel 6151: span.LC_message_link {
1.858     bisitz   6152:   /* background: $feedback_link_bg; */
1.599     albertel 6153:   font-size: larger;
                   6154:   position: absolute;
                   6155:   right: 1em;
1.489     raeburn  6156: }
1.421     albertel 6157: 
1.515     albertel 6158: table.LC_prior_tries {
1.524     albertel 6159:   border: 1px solid #000000;
                   6160:   border-collapse: separate;
                   6161:   border-spacing: 1px;
1.515     albertel 6162: }
1.523     albertel 6163: 
1.515     albertel 6164: table.LC_prior_tries td {
1.524     albertel 6165:   padding: 2px;
1.515     albertel 6166: }
1.523     albertel 6167: 
                   6168: .LC_answer_correct {
1.795     www      6169:   background: lightgreen;
                   6170:   color: darkgreen;
                   6171:   padding: 6px;
1.523     albertel 6172: }
1.795     www      6173: 
1.523     albertel 6174: .LC_answer_charged_try {
1.797     www      6175:   background: #FFAAAA;
1.795     www      6176:   color: darkred;
                   6177:   padding: 6px;
1.523     albertel 6178: }
1.795     www      6179: 
1.779     bisitz   6180: .LC_answer_not_charged_try,
1.523     albertel 6181: .LC_answer_no_grade,
                   6182: .LC_answer_late {
1.795     www      6183:   background: lightyellow;
1.523     albertel 6184:   color: black;
1.795     www      6185:   padding: 6px;
1.523     albertel 6186: }
1.795     www      6187: 
1.523     albertel 6188: .LC_answer_previous {
1.795     www      6189:   background: lightblue;
                   6190:   color: darkblue;
                   6191:   padding: 6px;
1.523     albertel 6192: }
1.795     www      6193: 
1.779     bisitz   6194: .LC_answer_no_message {
1.777     tempelho 6195:   background: #FFFFFF;
                   6196:   color: black;
1.795     www      6197:   padding: 6px;
1.779     bisitz   6198: }
1.795     www      6199: 
1.779     bisitz   6200: .LC_answer_unknown {
                   6201:   background: orange;
                   6202:   color: black;
1.795     www      6203:   padding: 6px;
1.777     tempelho 6204: }
1.795     www      6205: 
1.529     albertel 6206: span.LC_prior_numerical,
                   6207: span.LC_prior_string,
                   6208: span.LC_prior_custom,
                   6209: span.LC_prior_reaction,
                   6210: span.LC_prior_math {
1.925     bisitz   6211:   font-family: $mono;
1.523     albertel 6212:   white-space: pre;
                   6213: }
                   6214: 
1.525     albertel 6215: span.LC_prior_string {
1.925     bisitz   6216:   font-family: $mono;
1.525     albertel 6217:   white-space: pre;
                   6218: }
                   6219: 
1.523     albertel 6220: table.LC_prior_option {
                   6221:   width: 100%;
                   6222:   border-collapse: collapse;
                   6223: }
1.795     www      6224: 
1.911     bisitz   6225: table.LC_prior_rank,
1.795     www      6226: table.LC_prior_match {
1.528     albertel 6227:   border-collapse: collapse;
                   6228: }
1.795     www      6229: 
1.528     albertel 6230: table.LC_prior_option tr td,
                   6231: table.LC_prior_rank tr td,
                   6232: table.LC_prior_match tr td {
1.524     albertel 6233:   border: 1px solid #000000;
1.515     albertel 6234: }
                   6235: 
1.855     bisitz   6236: .LC_nobreak {
1.544     albertel 6237:   white-space: nowrap;
1.519     raeburn  6238: }
                   6239: 
1.576     raeburn  6240: span.LC_cusr_emph {
                   6241:   font-style: italic;
                   6242: }
                   6243: 
1.633     raeburn  6244: span.LC_cusr_subheading {
                   6245:   font-weight: normal;
                   6246:   font-size: 85%;
                   6247: }
                   6248: 
1.861     bisitz   6249: div.LC_docs_entry_move {
1.859     bisitz   6250:   border: 1px solid #BBBBBB;
1.545     albertel 6251:   background: #DDDDDD;
1.861     bisitz   6252:   width: 22px;
1.859     bisitz   6253:   padding: 1px;
                   6254:   margin: 0;
1.545     albertel 6255: }
                   6256: 
1.861     bisitz   6257: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6258: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6259:   font-size: x-small;
                   6260: }
1.795     www      6261: 
1.861     bisitz   6262: .LC_docs_entry_parameter {
                   6263:   white-space: nowrap;
                   6264: }
                   6265: 
1.544     albertel 6266: .LC_docs_copy {
1.545     albertel 6267:   color: #000099;
1.544     albertel 6268: }
1.795     www      6269: 
1.544     albertel 6270: .LC_docs_cut {
1.545     albertel 6271:   color: #550044;
1.544     albertel 6272: }
1.795     www      6273: 
1.544     albertel 6274: .LC_docs_rename {
1.545     albertel 6275:   color: #009900;
1.544     albertel 6276: }
1.795     www      6277: 
1.544     albertel 6278: .LC_docs_remove {
1.545     albertel 6279:   color: #990000;
                   6280: }
                   6281: 
1.547     albertel 6282: .LC_docs_reinit_warn,
                   6283: .LC_docs_ext_edit {
                   6284:   font-size: x-small;
                   6285: }
                   6286: 
1.545     albertel 6287: table.LC_docs_adddocs td,
                   6288: table.LC_docs_adddocs th {
                   6289:   border: 1px solid #BBBBBB;
                   6290:   padding: 4px;
                   6291:   background: #DDDDDD;
1.543     albertel 6292: }
                   6293: 
1.584     albertel 6294: table.LC_sty_begin {
                   6295:   background: #BBFFBB;
                   6296: }
1.795     www      6297: 
1.584     albertel 6298: table.LC_sty_end {
                   6299:   background: #FFBBBB;
                   6300: }
                   6301: 
1.589     raeburn  6302: table.LC_double_column {
1.803     bisitz   6303:   border-width: 0;
1.589     raeburn  6304:   border-collapse: collapse;
                   6305:   width: 100%;
                   6306:   padding: 2px;
                   6307: }
                   6308: 
                   6309: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6310:   top: 2px;
1.589     raeburn  6311:   left: 2px;
                   6312:   width: 47%;
                   6313:   vertical-align: top;
                   6314: }
                   6315: 
                   6316: table.LC_double_column tr td.LC_right_col {
                   6317:   top: 2px;
1.779     bisitz   6318:   right: 2px;
1.589     raeburn  6319:   width: 47%;
                   6320:   vertical-align: top;
                   6321: }
                   6322: 
1.591     raeburn  6323: div.LC_left_float {
                   6324:   float: left;
                   6325:   padding-right: 5%;
1.597     albertel 6326:   padding-bottom: 4px;
1.591     raeburn  6327: }
                   6328: 
                   6329: div.LC_clear_float_header {
1.597     albertel 6330:   padding-bottom: 2px;
1.591     raeburn  6331: }
                   6332: 
                   6333: div.LC_clear_float_footer {
1.597     albertel 6334:   padding-top: 10px;
1.591     raeburn  6335:   clear: both;
                   6336: }
                   6337: 
1.597     albertel 6338: div.LC_grade_show_user {
1.941     bisitz   6339: /*  border-left: 5px solid $sidebg; */
                   6340:   border-top: 5px solid #000000;
                   6341:   margin: 50px 0 0 0;
1.936     bisitz   6342:   padding: 15px 0 5px 10px;
1.597     albertel 6343: }
1.795     www      6344: 
1.936     bisitz   6345: div.LC_grade_show_user_odd_row {
1.941     bisitz   6346: /*  border-left: 5px solid #000000; */
                   6347: }
                   6348: 
                   6349: div.LC_grade_show_user div.LC_Box {
                   6350:   margin-right: 50px;
1.597     albertel 6351: }
                   6352: 
                   6353: div.LC_grade_submissions,
                   6354: div.LC_grade_message_center,
1.936     bisitz   6355: div.LC_grade_info_links {
1.597     albertel 6356:   margin: 5px;
                   6357:   width: 99%;
                   6358:   background: #FFFFFF;
                   6359: }
1.795     www      6360: 
1.597     albertel 6361: div.LC_grade_submissions_header,
1.936     bisitz   6362: div.LC_grade_message_center_header {
1.705     tempelho 6363:   font-weight: bold;
                   6364:   font-size: large;
1.597     albertel 6365: }
1.795     www      6366: 
1.597     albertel 6367: div.LC_grade_submissions_body,
1.936     bisitz   6368: div.LC_grade_message_center_body {
1.597     albertel 6369:   border: 1px solid black;
                   6370:   width: 99%;
                   6371:   background: #FFFFFF;
                   6372: }
1.795     www      6373: 
1.613     albertel 6374: table.LC_scantron_action {
                   6375:   width: 100%;
                   6376: }
1.795     www      6377: 
1.613     albertel 6378: table.LC_scantron_action tr th {
1.698     harmsja  6379:   font-weight:bold;
                   6380:   font-style:normal;
1.613     albertel 6381: }
1.795     www      6382: 
1.779     bisitz   6383: .LC_edit_problem_header,
1.614     albertel 6384: div.LC_edit_problem_footer {
1.705     tempelho 6385:   font-weight: normal;
                   6386:   font-size:  medium;
1.602     albertel 6387:   margin: 2px;
1.1060    bisitz   6388:   background-color: $sidebg;
1.600     albertel 6389: }
1.795     www      6390: 
1.600     albertel 6391: div.LC_edit_problem_header,
1.602     albertel 6392: div.LC_edit_problem_header div,
1.614     albertel 6393: div.LC_edit_problem_footer,
                   6394: div.LC_edit_problem_footer div,
1.602     albertel 6395: div.LC_edit_problem_editxml_header,
                   6396: div.LC_edit_problem_editxml_header div {
1.600     albertel 6397:   margin-top: 5px;
                   6398: }
1.795     www      6399: 
1.600     albertel 6400: div.LC_edit_problem_header_title {
1.705     tempelho 6401:   font-weight: bold;
                   6402:   font-size: larger;
1.602     albertel 6403:   background: $tabbg;
                   6404:   padding: 3px;
1.1060    bisitz   6405:   margin: 0 0 5px 0;
1.602     albertel 6406: }
1.795     www      6407: 
1.602     albertel 6408: table.LC_edit_problem_header_title {
                   6409:   width: 100%;
1.600     albertel 6410:   background: $tabbg;
1.602     albertel 6411: }
                   6412: 
                   6413: div.LC_edit_problem_discards {
                   6414:   float: left;
                   6415:   padding-bottom: 5px;
                   6416: }
1.795     www      6417: 
1.602     albertel 6418: div.LC_edit_problem_saves {
                   6419:   float: right;
                   6420:   padding-bottom: 5px;
1.600     albertel 6421: }
1.795     www      6422: 
1.911     bisitz   6423: img.stift {
1.803     bisitz   6424:   border-width: 0;
                   6425:   vertical-align: middle;
1.677     riegler  6426: }
1.680     riegler  6427: 
1.923     bisitz   6428: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6429:   vertical-align: top;
1.777     tempelho 6430: }
1.795     www      6431: 
1.716     raeburn  6432: div.LC_createcourse {
1.911     bisitz   6433:   margin: 10px 10px 10px 10px;
1.716     raeburn  6434: }
                   6435: 
1.917     raeburn  6436: .LC_dccid {
                   6437:   margin: 0.2em 0 0 0;
                   6438:   padding: 0;
                   6439:   font-size: 90%;
                   6440:   display:none;
                   6441: }
                   6442: 
1.897     wenzelju 6443: ol.LC_primary_menu a:hover,
1.721     harmsja  6444: ol#LC_MenuBreadcrumbs a:hover,
                   6445: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6446: ul#LC_secondary_menu a:hover,
1.721     harmsja  6447: .LC_FormSectionClearButton input:hover
1.795     www      6448: ul.LC_TabContent   li:hover a {
1.952     onken    6449:   color:$button_hover;
1.911     bisitz   6450:   text-decoration:none;
1.693     droeschl 6451: }
                   6452: 
1.779     bisitz   6453: h1 {
1.911     bisitz   6454:   padding: 0;
                   6455:   line-height:130%;
1.693     droeschl 6456: }
1.698     harmsja  6457: 
1.911     bisitz   6458: h2,
                   6459: h3,
                   6460: h4,
                   6461: h5,
                   6462: h6 {
                   6463:   margin: 5px 0 5px 0;
                   6464:   padding: 0;
                   6465:   line-height:130%;
1.693     droeschl 6466: }
1.795     www      6467: 
                   6468: .LC_hcell {
1.911     bisitz   6469:   padding:3px 15px 3px 15px;
                   6470:   margin: 0;
                   6471:   background-color:$tabbg;
                   6472:   color:$fontmenu;
                   6473:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6474: }
1.795     www      6475: 
1.840     bisitz   6476: .LC_Box > .LC_hcell {
1.911     bisitz   6477:   margin: 0 -10px 10px -10px;
1.835     bisitz   6478: }
                   6479: 
1.721     harmsja  6480: .LC_noBorder {
1.911     bisitz   6481:   border: 0;
1.698     harmsja  6482: }
1.693     droeschl 6483: 
1.721     harmsja  6484: .LC_FormSectionClearButton input {
1.911     bisitz   6485:   background-color:transparent;
                   6486:   border: none;
                   6487:   cursor:pointer;
                   6488:   text-decoration:underline;
1.693     droeschl 6489: }
1.763     bisitz   6490: 
                   6491: .LC_help_open_topic {
1.911     bisitz   6492:   color: #FFFFFF;
                   6493:   background-color: #EEEEFF;
                   6494:   margin: 1px;
                   6495:   padding: 4px;
                   6496:   border: 1px solid #000033;
                   6497:   white-space: nowrap;
                   6498:   /* vertical-align: middle; */
1.759     neumanie 6499: }
1.693     droeschl 6500: 
1.911     bisitz   6501: dl,
                   6502: ul,
                   6503: div,
                   6504: fieldset {
                   6505:   margin: 10px 10px 10px 0;
                   6506:   /* overflow: hidden; */
1.693     droeschl 6507: }
1.795     www      6508: 
1.838     bisitz   6509: fieldset > legend {
1.911     bisitz   6510:   font-weight: bold;
                   6511:   padding: 0 5px 0 5px;
1.838     bisitz   6512: }
                   6513: 
1.813     bisitz   6514: #LC_nav_bar {
1.911     bisitz   6515:   float: left;
1.995     raeburn  6516:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6517:   margin: 0 0 2px 0;
1.807     droeschl 6518: }
                   6519: 
1.916     droeschl 6520: #LC_realm {
                   6521:   margin: 0.2em 0 0 0;
                   6522:   padding: 0;
                   6523:   font-weight: bold;
                   6524:   text-align: center;
1.995     raeburn  6525:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6526: }
                   6527: 
1.911     bisitz   6528: #LC_nav_bar em {
                   6529:   font-weight: bold;
                   6530:   font-style: normal;
1.807     droeschl 6531: }
                   6532: 
1.897     wenzelju 6533: ol.LC_primary_menu {
1.911     bisitz   6534:   float: right;
1.934     droeschl 6535:   margin: 0;
1.1075.2.2  raeburn  6536:   padding: 0;
1.995     raeburn  6537:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6538: }
                   6539: 
1.852     droeschl 6540: ol#LC_PathBreadcrumbs {
1.911     bisitz   6541:   margin: 0;
1.693     droeschl 6542: }
                   6543: 
1.897     wenzelju 6544: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6545:   color: RGB(80, 80, 80);
                   6546:   vertical-align: middle;
                   6547:   text-align: left;
                   6548:   list-style: none;
                   6549:   float: left;
                   6550: }
                   6551: 
                   6552: ol.LC_primary_menu li a {
                   6553:   display: block;
                   6554:   margin: 0;
                   6555:   padding: 0 5px 0 10px;
                   6556:   text-decoration: none;
                   6557: }
                   6558: 
                   6559: ol.LC_primary_menu li ul {
                   6560:   display: none;
                   6561:   width: 10em;
                   6562:   background-color: $data_table_light;
                   6563: }
                   6564: 
                   6565: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6566:   display: block;
                   6567:   position: absolute;
                   6568:   margin: 0;
                   6569:   padding: 0;
1.1075.2.5  raeburn  6570:   z-index: 2;
1.1075.2.2  raeburn  6571: }
                   6572: 
                   6573: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6574:   font-size: 90%;
1.911     bisitz   6575:   vertical-align: top;
1.1075.2.2  raeburn  6576:   float: none;
1.1075.2.5  raeburn  6577:   border-left: 1px solid black;
                   6578:   border-right: 1px solid black;
1.1075.2.2  raeburn  6579: }
                   6580: 
                   6581: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6582:   background-color:$data_table_light;
1.1075.2.2  raeburn  6583: }
                   6584: 
                   6585: ol.LC_primary_menu li li a:hover {
                   6586:    color:$button_hover;
                   6587:    background-color:$data_table_dark;
1.693     droeschl 6588: }
                   6589: 
1.897     wenzelju 6590: ol.LC_primary_menu li img {
1.911     bisitz   6591:   vertical-align: bottom;
1.934     droeschl 6592:   height: 1.1em;
1.1075.2.3  raeburn  6593:   margin: 0.2em 0 0 0;
1.693     droeschl 6594: }
                   6595: 
1.897     wenzelju 6596: ol.LC_primary_menu a {
1.911     bisitz   6597:   color: RGB(80, 80, 80);
                   6598:   text-decoration: none;
1.693     droeschl 6599: }
1.795     www      6600: 
1.949     droeschl 6601: ol.LC_primary_menu a.LC_new_message {
                   6602:   font-weight:bold;
                   6603:   color: darkred;
                   6604: }
                   6605: 
1.975     raeburn  6606: ol.LC_docs_parameters {
                   6607:   margin-left: 0;
                   6608:   padding: 0;
                   6609:   list-style: none;
                   6610: }
                   6611: 
                   6612: ol.LC_docs_parameters li {
                   6613:   margin: 0;
                   6614:   padding-right: 20px;
                   6615:   display: inline;
                   6616: }
                   6617: 
1.976     raeburn  6618: ol.LC_docs_parameters li:before {
                   6619:   content: "\\002022 \\0020";
                   6620: }
                   6621: 
                   6622: li.LC_docs_parameters_title {
                   6623:   font-weight: bold;
                   6624: }
                   6625: 
                   6626: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6627:   content: "";
                   6628: }
                   6629: 
1.897     wenzelju 6630: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6631:   clear: right;
1.911     bisitz   6632:   color: $fontmenu;
                   6633:   background: $tabbg;
                   6634:   list-style: none;
                   6635:   padding: 0;
                   6636:   margin: 0;
                   6637:   width: 100%;
1.995     raeburn  6638:   text-align: left;
1.1075.2.4  raeburn  6639:   float: left;
1.808     droeschl 6640: }
                   6641: 
1.897     wenzelju 6642: ul#LC_secondary_menu li {
1.911     bisitz   6643:   font-weight: bold;
                   6644:   line-height: 1.8em;
                   6645:   border-right: 1px solid black;
                   6646:   vertical-align: middle;
1.1075.2.4  raeburn  6647:   float: left;
                   6648: }
                   6649: 
                   6650: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6651:   background-color: $data_table_light;
                   6652: }
                   6653: 
                   6654: ul#LC_secondary_menu li a {
                   6655:   padding: 0 0.8em;
                   6656: }
                   6657: 
                   6658: ul#LC_secondary_menu li ul {
                   6659:   display: none;
                   6660: }
                   6661: 
                   6662: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6663:   display: block;
                   6664:   position: absolute;
                   6665:   margin: 0;
                   6666:   padding: 0;
                   6667:   list-style:none;
                   6668:   float: none;
                   6669:   background-color: $data_table_light;
1.1075.2.5  raeburn  6670:   z-index: 2;
1.1075.2.10  raeburn  6671:   margin-left: -1px;
1.1075.2.4  raeburn  6672: }
                   6673: 
                   6674: ul#LC_secondary_menu li ul li {
                   6675:   font-size: 90%;
                   6676:   vertical-align: top;
                   6677:   border-left: 1px solid black;
                   6678:   border-right: 1px solid black;
                   6679:   background-color: $data_table_light
                   6680:   list-style:none;
                   6681:   float: none;
                   6682: }
                   6683: 
                   6684: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6685:   background-color: $data_table_dark;
1.807     droeschl 6686: }
                   6687: 
1.847     tempelho 6688: ul.LC_TabContent {
1.911     bisitz   6689:   display:block;
                   6690:   background: $sidebg;
                   6691:   border-bottom: solid 1px $lg_border_color;
                   6692:   list-style:none;
1.1020    raeburn  6693:   margin: -1px -10px 0 -10px;
1.911     bisitz   6694:   padding: 0;
1.693     droeschl 6695: }
                   6696: 
1.795     www      6697: ul.LC_TabContent li,
                   6698: ul.LC_TabContentBigger li {
1.911     bisitz   6699:   float:left;
1.741     harmsja  6700: }
1.795     www      6701: 
1.897     wenzelju 6702: ul#LC_secondary_menu li a {
1.911     bisitz   6703:   color: $fontmenu;
                   6704:   text-decoration: none;
1.693     droeschl 6705: }
1.795     www      6706: 
1.721     harmsja  6707: ul.LC_TabContent {
1.952     onken    6708:   min-height:20px;
1.721     harmsja  6709: }
1.795     www      6710: 
                   6711: ul.LC_TabContent li {
1.911     bisitz   6712:   vertical-align:middle;
1.959     onken    6713:   padding: 0 16px 0 10px;
1.911     bisitz   6714:   background-color:$tabbg;
                   6715:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6716:   border-left: solid 1px $font;
1.721     harmsja  6717: }
1.795     www      6718: 
1.847     tempelho 6719: ul.LC_TabContent .right {
1.911     bisitz   6720:   float:right;
1.847     tempelho 6721: }
                   6722: 
1.911     bisitz   6723: ul.LC_TabContent li a,
                   6724: ul.LC_TabContent li {
                   6725:   color:rgb(47,47,47);
                   6726:   text-decoration:none;
                   6727:   font-size:95%;
                   6728:   font-weight:bold;
1.952     onken    6729:   min-height:20px;
                   6730: }
                   6731: 
1.959     onken    6732: ul.LC_TabContent li a:hover,
                   6733: ul.LC_TabContent li a:focus {
1.952     onken    6734:   color: $button_hover;
1.959     onken    6735:   background:none;
                   6736:   outline:none;
1.952     onken    6737: }
                   6738: 
                   6739: ul.LC_TabContent li:hover {
                   6740:   color: $button_hover;
                   6741:   cursor:pointer;
1.721     harmsja  6742: }
1.795     www      6743: 
1.911     bisitz   6744: ul.LC_TabContent li.active {
1.952     onken    6745:   color: $font;
1.911     bisitz   6746:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6747:   border-bottom:solid 1px #FFFFFF;
                   6748:   cursor: default;
1.744     ehlerst  6749: }
1.795     www      6750: 
1.959     onken    6751: ul.LC_TabContent li.active a {
                   6752:   color:$font;
                   6753:   background:#FFFFFF;
                   6754:   outline: none;
                   6755: }
1.1047    raeburn  6756: 
                   6757: ul.LC_TabContent li.goback {
                   6758:   float: left;
                   6759:   border-left: none;
                   6760: }
                   6761: 
1.870     tempelho 6762: #maincoursedoc {
1.911     bisitz   6763:   clear:both;
1.870     tempelho 6764: }
                   6765: 
                   6766: ul.LC_TabContentBigger {
1.911     bisitz   6767:   display:block;
                   6768:   list-style:none;
                   6769:   padding: 0;
1.870     tempelho 6770: }
                   6771: 
1.795     www      6772: ul.LC_TabContentBigger li {
1.911     bisitz   6773:   vertical-align:bottom;
                   6774:   height: 30px;
                   6775:   font-size:110%;
                   6776:   font-weight:bold;
                   6777:   color: #737373;
1.841     tempelho 6778: }
                   6779: 
1.957     onken    6780: ul.LC_TabContentBigger li.active {
                   6781:   position: relative;
                   6782:   top: 1px;
                   6783: }
                   6784: 
1.870     tempelho 6785: ul.LC_TabContentBigger li a {
1.911     bisitz   6786:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6787:   height: 30px;
                   6788:   line-height: 30px;
                   6789:   text-align: center;
                   6790:   display: block;
                   6791:   text-decoration: none;
1.958     onken    6792:   outline: none;  
1.741     harmsja  6793: }
1.795     www      6794: 
1.870     tempelho 6795: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6796:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6797:   color:$font;
1.744     ehlerst  6798: }
1.795     www      6799: 
1.870     tempelho 6800: ul.LC_TabContentBigger li b {
1.911     bisitz   6801:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6802:   display: block;
                   6803:   float: left;
                   6804:   padding: 0 30px;
1.957     onken    6805:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6806: }
                   6807: 
1.956     onken    6808: ul.LC_TabContentBigger li:hover b {
                   6809:   color:$button_hover;
                   6810: }
                   6811: 
1.870     tempelho 6812: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6813:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6814:   color:$font;
1.957     onken    6815:   border: 0;
1.741     harmsja  6816: }
1.693     droeschl 6817: 
1.870     tempelho 6818: 
1.862     bisitz   6819: ul.LC_CourseBreadcrumbs {
                   6820:   background: $sidebg;
1.1020    raeburn  6821:   height: 2em;
1.862     bisitz   6822:   padding-left: 10px;
1.1020    raeburn  6823:   margin: 0;
1.862     bisitz   6824:   list-style-position: inside;
                   6825: }
                   6826: 
1.911     bisitz   6827: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6828: ol#LC_PathBreadcrumbs {
1.911     bisitz   6829:   padding-left: 10px;
                   6830:   margin: 0;
1.933     droeschl 6831:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6832: }
                   6833: 
1.911     bisitz   6834: ol#LC_MenuBreadcrumbs li,
                   6835: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6836: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6837:   display: inline;
1.933     droeschl 6838:   white-space: normal;  
1.693     droeschl 6839: }
                   6840: 
1.823     bisitz   6841: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6842: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6843:   text-decoration: none;
                   6844:   font-size:90%;
1.693     droeschl 6845: }
1.795     www      6846: 
1.969     droeschl 6847: ol#LC_MenuBreadcrumbs h1 {
                   6848:   display: inline;
                   6849:   font-size: 90%;
                   6850:   line-height: 2.5em;
                   6851:   margin: 0;
                   6852:   padding: 0;
                   6853: }
                   6854: 
1.795     www      6855: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6856:   text-decoration:none;
                   6857:   font-size:100%;
                   6858:   font-weight:bold;
1.693     droeschl 6859: }
1.795     www      6860: 
1.840     bisitz   6861: .LC_Box {
1.911     bisitz   6862:   border: solid 1px $lg_border_color;
                   6863:   padding: 0 10px 10px 10px;
1.746     neumanie 6864: }
1.795     www      6865: 
1.1020    raeburn  6866: .LC_DocsBox {
                   6867:   border: solid 1px $lg_border_color;
                   6868:   padding: 0 0 10px 10px;
                   6869: }
                   6870: 
1.795     www      6871: .LC_AboutMe_Image {
1.911     bisitz   6872:   float:left;
                   6873:   margin-right:10px;
1.747     neumanie 6874: }
1.795     www      6875: 
                   6876: .LC_Clear_AboutMe_Image {
1.911     bisitz   6877:   clear:left;
1.747     neumanie 6878: }
1.795     www      6879: 
1.721     harmsja  6880: dl.LC_ListStyleClean dt {
1.911     bisitz   6881:   padding-right: 5px;
                   6882:   display: table-header-group;
1.693     droeschl 6883: }
                   6884: 
1.721     harmsja  6885: dl.LC_ListStyleClean dd {
1.911     bisitz   6886:   display: table-row;
1.693     droeschl 6887: }
                   6888: 
1.721     harmsja  6889: .LC_ListStyleClean,
                   6890: .LC_ListStyleSimple,
                   6891: .LC_ListStyleNormal,
1.795     www      6892: .LC_ListStyleSpecial {
1.911     bisitz   6893:   /* display:block; */
                   6894:   list-style-position: inside;
                   6895:   list-style-type: none;
                   6896:   overflow: hidden;
                   6897:   padding: 0;
1.693     droeschl 6898: }
                   6899: 
1.721     harmsja  6900: .LC_ListStyleSimple li,
                   6901: .LC_ListStyleSimple dd,
                   6902: .LC_ListStyleNormal li,
                   6903: .LC_ListStyleNormal dd,
                   6904: .LC_ListStyleSpecial li,
1.795     www      6905: .LC_ListStyleSpecial dd {
1.911     bisitz   6906:   margin: 0;
                   6907:   padding: 5px 5px 5px 10px;
                   6908:   clear: both;
1.693     droeschl 6909: }
                   6910: 
1.721     harmsja  6911: .LC_ListStyleClean li,
                   6912: .LC_ListStyleClean dd {
1.911     bisitz   6913:   padding-top: 0;
                   6914:   padding-bottom: 0;
1.693     droeschl 6915: }
                   6916: 
1.721     harmsja  6917: .LC_ListStyleSimple dd,
1.795     www      6918: .LC_ListStyleSimple li {
1.911     bisitz   6919:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6920: }
                   6921: 
1.721     harmsja  6922: .LC_ListStyleSpecial li,
                   6923: .LC_ListStyleSpecial dd {
1.911     bisitz   6924:   list-style-type: none;
                   6925:   background-color: RGB(220, 220, 220);
                   6926:   margin-bottom: 4px;
1.693     droeschl 6927: }
                   6928: 
1.721     harmsja  6929: table.LC_SimpleTable {
1.911     bisitz   6930:   margin:5px;
                   6931:   border:solid 1px $lg_border_color;
1.795     www      6932: }
1.693     droeschl 6933: 
1.721     harmsja  6934: table.LC_SimpleTable tr {
1.911     bisitz   6935:   padding: 0;
                   6936:   border:solid 1px $lg_border_color;
1.693     droeschl 6937: }
1.795     www      6938: 
                   6939: table.LC_SimpleTable thead {
1.911     bisitz   6940:   background:rgb(220,220,220);
1.693     droeschl 6941: }
                   6942: 
1.721     harmsja  6943: div.LC_columnSection {
1.911     bisitz   6944:   display: block;
                   6945:   clear: both;
                   6946:   overflow: hidden;
                   6947:   margin: 0;
1.693     droeschl 6948: }
                   6949: 
1.721     harmsja  6950: div.LC_columnSection>* {
1.911     bisitz   6951:   float: left;
                   6952:   margin: 10px 20px 10px 0;
                   6953:   overflow:hidden;
1.693     droeschl 6954: }
1.721     harmsja  6955: 
1.795     www      6956: table em {
1.911     bisitz   6957:   font-weight: bold;
                   6958:   font-style: normal;
1.748     schulted 6959: }
1.795     www      6960: 
1.779     bisitz   6961: table.LC_tableBrowseRes,
1.795     www      6962: table.LC_tableOfContent {
1.911     bisitz   6963:   border:none;
                   6964:   border-spacing: 1px;
                   6965:   padding: 3px;
                   6966:   background-color: #FFFFFF;
                   6967:   font-size: 90%;
1.753     droeschl 6968: }
1.789     droeschl 6969: 
1.911     bisitz   6970: table.LC_tableOfContent {
                   6971:   border-collapse: collapse;
1.789     droeschl 6972: }
                   6973: 
1.771     droeschl 6974: table.LC_tableBrowseRes a,
1.768     schulted 6975: table.LC_tableOfContent a {
1.911     bisitz   6976:   background-color: transparent;
                   6977:   text-decoration: none;
1.753     droeschl 6978: }
                   6979: 
1.795     www      6980: table.LC_tableOfContent img {
1.911     bisitz   6981:   border: none;
                   6982:   height: 1.3em;
                   6983:   vertical-align: text-bottom;
                   6984:   margin-right: 0.3em;
1.753     droeschl 6985: }
1.757     schulted 6986: 
1.795     www      6987: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6988:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6989: }
                   6990: 
1.795     www      6991: a#LC_content_toolbar_everything {
1.911     bisitz   6992:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6993: }
                   6994: 
1.795     www      6995: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6996:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6997: }
                   6998: 
1.795     www      6999: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7000:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7001: }
                   7002: 
1.795     www      7003: a#LC_content_toolbar_changefolder {
1.911     bisitz   7004:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7005: }
                   7006: 
1.795     www      7007: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7008:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7009: }
                   7010: 
1.1043    raeburn  7011: a#LC_content_toolbar_edittoplevel {
                   7012:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7013: }
                   7014: 
1.795     www      7015: ul#LC_toolbar li a:hover {
1.911     bisitz   7016:   background-position: bottom center;
1.757     schulted 7017: }
                   7018: 
1.795     www      7019: ul#LC_toolbar {
1.911     bisitz   7020:   padding: 0;
                   7021:   margin: 2px;
                   7022:   list-style:none;
                   7023:   position:relative;
                   7024:   background-color:white;
1.1075.2.9  raeburn  7025:   overflow: auto;
1.757     schulted 7026: }
                   7027: 
1.795     www      7028: ul#LC_toolbar li {
1.911     bisitz   7029:   border:1px solid white;
                   7030:   padding: 0;
                   7031:   margin: 0;
                   7032:   float: left;
                   7033:   display:inline;
                   7034:   vertical-align:middle;
1.1075.2.9  raeburn  7035:   white-space: nowrap;
1.911     bisitz   7036: }
1.757     schulted 7037: 
1.783     amueller 7038: 
1.795     www      7039: a.LC_toolbarItem {
1.911     bisitz   7040:   display:block;
                   7041:   padding: 0;
                   7042:   margin: 0;
                   7043:   height: 32px;
                   7044:   width: 32px;
                   7045:   color:white;
                   7046:   border: none;
                   7047:   background-repeat:no-repeat;
                   7048:   background-color:transparent;
1.757     schulted 7049: }
                   7050: 
1.915     droeschl 7051: ul.LC_funclist {
                   7052:     margin: 0;
                   7053:     padding: 0.5em 1em 0.5em 0;
                   7054: }
                   7055: 
1.933     droeschl 7056: ul.LC_funclist > li:first-child {
                   7057:     font-weight:bold; 
                   7058:     margin-left:0.8em;
                   7059: }
                   7060: 
1.915     droeschl 7061: ul.LC_funclist + ul.LC_funclist {
                   7062:     /* 
                   7063:        left border as a seperator if we have more than
                   7064:        one list 
                   7065:     */
                   7066:     border-left: 1px solid $sidebg;
                   7067:     /* 
                   7068:        this hides the left border behind the border of the 
                   7069:        outer box if element is wrapped to the next 'line' 
                   7070:     */
                   7071:     margin-left: -1px;
                   7072: }
                   7073: 
1.843     bisitz   7074: ul.LC_funclist li {
1.915     droeschl 7075:   display: inline;
1.782     bisitz   7076:   white-space: nowrap;
1.915     droeschl 7077:   margin: 0 0 0 25px;
                   7078:   line-height: 150%;
1.782     bisitz   7079: }
                   7080: 
1.974     wenzelju 7081: .LC_hidden {
                   7082:   display: none;
                   7083: }
                   7084: 
1.1030    www      7085: .LCmodal-overlay {
                   7086: 		position:fixed;
                   7087: 		top:0;
                   7088: 		right:0;
                   7089: 		bottom:0;
                   7090: 		left:0;
                   7091: 		height:100%;
                   7092: 		width:100%;
                   7093: 		margin:0;
                   7094: 		padding:0;
                   7095: 		background:#999;
                   7096: 		opacity:.75;
                   7097: 		filter: alpha(opacity=75);
                   7098: 		-moz-opacity: 0.75;
                   7099: 		z-index:101;
                   7100: }
                   7101: 
                   7102: * html .LCmodal-overlay {   
                   7103: 		position: absolute;
                   7104: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7105: }
                   7106: 
                   7107: .LCmodal-window {
                   7108: 		position:fixed;
                   7109: 		top:50%;
                   7110: 		left:50%;
                   7111: 		margin:0;
                   7112: 		padding:0;
                   7113: 		z-index:102;
                   7114: 	}
                   7115: 
                   7116: * html .LCmodal-window {
                   7117: 		position:absolute;
                   7118: }
                   7119: 
                   7120: .LCclose-window {
                   7121: 		position:absolute;
                   7122: 		width:32px;
                   7123: 		height:32px;
                   7124: 		right:8px;
                   7125: 		top:8px;
                   7126: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7127: 		text-indent:-99999px;
                   7128: 		overflow:hidden;
                   7129: 		cursor:pointer;
                   7130: }
                   7131: 
1.1075.2.17  raeburn  7132: /*
                   7133:   styles used by TTH when "Default set of options to pass to tth/m
                   7134:   when converting TeX" in course settings has been set
                   7135: 
                   7136:   option passed: -t
                   7137: 
                   7138: */
                   7139: 
                   7140: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7141: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7142: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7143: td div.norm {line-height:normal;}
                   7144: 
                   7145: /*
                   7146:   option passed -y3
                   7147: */
                   7148: 
                   7149: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7150: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7151: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7152: 
1.343     albertel 7153: END
                   7154: }
                   7155: 
1.306     albertel 7156: =pod
                   7157: 
                   7158: =item * &headtag()
                   7159: 
                   7160: Returns a uniform footer for LON-CAPA web pages.
                   7161: 
1.307     albertel 7162: Inputs: $title - optional title for the head
                   7163:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7164:         $args - optional arguments
1.319     albertel 7165:             force_register - if is true call registerurl so the remote is 
                   7166:                              informed
1.415     albertel 7167:             redirect       -> array ref of
                   7168:                                    1- seconds before redirect occurs
                   7169:                                    2- url to redirect to
                   7170:                                    3- whether the side effect should occur
1.315     albertel 7171:                            (side effect of setting 
                   7172:                                $env{'internal.head.redirect'} to the url 
                   7173:                                redirected too)
1.352     albertel 7174:             domain         -> force to color decorate a page for a specific
                   7175:                                domain
                   7176:             function       -> force usage of a specific rolish color scheme
                   7177:             bgcolor        -> override the default page bgcolor
1.460     albertel 7178:             no_auto_mt_title
                   7179:                            -> prevent &mt()ing the title arg
1.464     albertel 7180: 
1.306     albertel 7181: =cut
                   7182: 
                   7183: sub headtag {
1.313     albertel 7184:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7185:     
1.363     albertel 7186:     my $function = $args->{'function'} || &get_users_function();
                   7187:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7188:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7189:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7190: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7191: 		   #time(),
1.418     albertel 7192: 		   $env{'environment.color.timestamp'},
1.363     albertel 7193: 		   $function,$domain,$bgcolor);
                   7194: 
1.369     www      7195:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7196: 
1.308     albertel 7197:     my $result =
                   7198: 	'<head>'.
1.461     albertel 7199: 	&font_settings();
1.319     albertel 7200: 
1.1064    raeburn  7201:     my $inhibitprint = &print_suppression();
                   7202: 
1.461     albertel 7203:     if (!$args->{'frameset'}) {
                   7204: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7205:     }
1.1075.2.12  raeburn  7206:     if ($args->{'force_register'}) {
                   7207:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7208:     }
1.436     albertel 7209:     if (!$args->{'no_nav_bar'} 
                   7210: 	&& !$args->{'only_body'}
                   7211: 	&& !$args->{'frameset'}) {
                   7212: 	$result .= &help_menu_js();
1.1032    www      7213:         $result.=&modal_window();
1.1038    www      7214:         $result.=&togglebox_script();
1.1034    www      7215:         $result.=&wishlist_window();
1.1041    www      7216:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7217:     } else {
                   7218:         if ($args->{'add_modal'}) {
                   7219:            $result.=&modal_window();
                   7220:         }
                   7221:         if ($args->{'add_wishlist'}) {
                   7222:            $result.=&wishlist_window();
                   7223:         }
1.1038    www      7224:         if ($args->{'add_togglebox'}) {
                   7225:            $result.=&togglebox_script();
                   7226:         }
1.1041    www      7227:         if ($args->{'add_progressbar'}) {
                   7228:            $result.=&LCprogressbarUpdate_script();
                   7229:         }
1.436     albertel 7230:     }
1.314     albertel 7231:     if (ref($args->{'redirect'})) {
1.414     albertel 7232: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7233: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7234: 	if (!$inhibit_continue) {
                   7235: 	    $env{'internal.head.redirect'} = $url;
                   7236: 	}
1.313     albertel 7237: 	$result.=<<ADDMETA
                   7238: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7239: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7240: ADDMETA
                   7241:     }
1.306     albertel 7242:     if (!defined($title)) {
                   7243: 	$title = 'The LearningOnline Network with CAPA';
                   7244:     }
1.460     albertel 7245:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7246:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7247: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7248:         .$inhibitprint
1.414     albertel 7249: 	.$head_extra;
1.962     droeschl 7250:     return $result.'</head>';
1.306     albertel 7251: }
                   7252: 
                   7253: =pod
                   7254: 
1.340     albertel 7255: =item * &font_settings()
                   7256: 
                   7257: Returns neccessary <meta> to set the proper encoding
                   7258: 
                   7259: Inputs: none
                   7260: 
                   7261: =cut
                   7262: 
                   7263: sub font_settings {
                   7264:     my $headerstring='';
1.647     www      7265:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7266: 	$headerstring.=
                   7267: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7268:     }
                   7269:     return $headerstring;
                   7270: }
                   7271: 
1.341     albertel 7272: =pod
                   7273: 
1.1064    raeburn  7274: =item * &print_suppression()
                   7275: 
                   7276: In course context returns css which causes the body to be blank when media="print",
                   7277: if printout generation is unavailable for the current resource.
                   7278: 
                   7279: This could be because:
                   7280: 
                   7281: (a) printstartdate is in the future
                   7282: 
                   7283: (b) printenddate is in the past
                   7284: 
                   7285: (c) there is an active exam block with "printout"
                   7286: functionality blocked
                   7287: 
                   7288: Users with pav, pfo or evb privileges are exempt.
                   7289: 
                   7290: Inputs: none
                   7291: 
                   7292: =cut
                   7293: 
                   7294: 
                   7295: sub print_suppression {
                   7296:     my $noprint;
                   7297:     if ($env{'request.course.id'}) {
                   7298:         my $scope = $env{'request.course.id'};
                   7299:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7300:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7301:             return;
                   7302:         }
                   7303:         if ($env{'request.course.sec'} ne '') {
                   7304:             $scope .= "/$env{'request.course.sec'}";
                   7305:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7306:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7307:                 return;
1.1064    raeburn  7308:             }
                   7309:         }
                   7310:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7311:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7312:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7313:         if ($blocked) {
                   7314:             my $checkrole = "cm./$cdom/$cnum";
                   7315:             if ($env{'request.course.sec'} ne '') {
                   7316:                 $checkrole .= "/$env{'request.course.sec'}";
                   7317:             }
                   7318:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7319:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7320:                 $noprint = 1;
                   7321:             }
                   7322:         }
                   7323:         unless ($noprint) {
                   7324:             my $symb = &Apache::lonnet::symbread();
                   7325:             if ($symb ne '') {
                   7326:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7327:                 if (ref($navmap)) {
                   7328:                     my $res = $navmap->getBySymb($symb);
                   7329:                     if (ref($res)) {
                   7330:                         if (!$res->resprintable()) {
                   7331:                             $noprint = 1;
                   7332:                         }
                   7333:                     }
                   7334:                 }
                   7335:             }
                   7336:         }
                   7337:         if ($noprint) {
                   7338:             return <<"ENDSTYLE";
                   7339: <style type="text/css" media="print">
                   7340:     body { display:none }
                   7341: </style>
                   7342: ENDSTYLE
                   7343:         }
                   7344:     }
                   7345:     return;
                   7346: }
                   7347: 
                   7348: =pod
                   7349: 
1.341     albertel 7350: =item * &xml_begin()
                   7351: 
                   7352: Returns the needed doctype and <html>
                   7353: 
                   7354: Inputs: none
                   7355: 
                   7356: =cut
                   7357: 
                   7358: sub xml_begin {
                   7359:     my $output='';
                   7360: 
                   7361:     if ($env{'browser.mathml'}) {
                   7362: 	$output='<?xml version="1.0"?>'
                   7363:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7364: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7365:             
                   7366: #	    .'<!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">] >'
                   7367: 	    .'<!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">'
                   7368:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7369: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7370:     } else {
1.849     bisitz   7371: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7372:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7373:     }
                   7374:     return $output;
                   7375: }
1.340     albertel 7376: 
                   7377: =pod
                   7378: 
1.306     albertel 7379: =item * &start_page()
                   7380: 
                   7381: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7382: 
1.648     raeburn  7383: Inputs:
                   7384: 
                   7385: =over 4
                   7386: 
                   7387: $title - optional title for the page
                   7388: 
                   7389: $head_extra - optional extra HTML to incude inside the <head>
                   7390: 
                   7391: $args - additional optional args supported are:
                   7392: 
                   7393: =over 8
                   7394: 
                   7395:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7396:                                     arg on
1.814     bisitz   7397:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7398:              add_entries    -> additional attributes to add to the  <body>
                   7399:              domain         -> force to color decorate a page for a 
1.317     albertel 7400:                                     specific domain
1.648     raeburn  7401:              function       -> force usage of a specific rolish color
1.317     albertel 7402:                                     scheme
1.648     raeburn  7403:              redirect       -> see &headtag()
                   7404:              bgcolor        -> override the default page bg color
                   7405:              js_ready       -> return a string ready for being used in 
1.317     albertel 7406:                                     a javascript writeln
1.648     raeburn  7407:              html_encode    -> return a string ready for being used in 
1.320     albertel 7408:                                     a html attribute
1.648     raeburn  7409:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7410:                                     $forcereg arg
1.648     raeburn  7411:              frameset       -> if true will start with a <frameset>
1.330     albertel 7412:                                     rather than <body>
1.648     raeburn  7413:              skip_phases    -> hash ref of 
1.338     albertel 7414:                                     head -> skip the <html><head> generation
                   7415:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7416:              no_inline_link -> if true and in remote mode, don't show the
                   7417:                                     'Switch To Inline Menu' link
1.648     raeburn  7418:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7419:              inherit_jsmath -> when creating popup window in a page,
                   7420:                                     should it have jsmath forced on by the
                   7421:                                     current page
1.867     kalberla 7422:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7423:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7424:              group          -> includes the current group, if page is for a
                   7425:                                specific group
1.361     albertel 7426: 
1.648     raeburn  7427: =back
1.460     albertel 7428: 
1.648     raeburn  7429: =back
1.562     albertel 7430: 
1.306     albertel 7431: =cut
                   7432: 
                   7433: sub start_page {
1.309     albertel 7434:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7435:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7436: 
1.315     albertel 7437:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7438:     my ($result,@advtools);
1.964     droeschl 7439: 
1.338     albertel 7440:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7441:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7442:     }
                   7443:     
                   7444:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7445: 	if ($args->{'frameset'}) {
                   7446: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7447: 						$args->{'add_entries'});
                   7448: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7449:         } else {
                   7450:             $result .=
                   7451:                 &bodytag($title, 
                   7452:                          $args->{'function'},       $args->{'add_entries'},
                   7453:                          $args->{'only_body'},      $args->{'domain'},
                   7454:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7455:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7456:                          $args,                     \@advtools);
1.831     bisitz   7457:         }
1.330     albertel 7458:     }
1.338     albertel 7459: 
1.315     albertel 7460:     if ($args->{'js_ready'}) {
1.713     kaisler  7461: 		$result = &js_ready($result);
1.315     albertel 7462:     }
1.320     albertel 7463:     if ($args->{'html_encode'}) {
1.713     kaisler  7464: 		$result = &html_encode($result);
                   7465:     }
                   7466: 
1.813     bisitz   7467:     # Preparation for new and consistent functionlist at top of screen
                   7468:     # if ($args->{'functionlist'}) {
                   7469:     #            $result .= &build_functionlist();
                   7470:     #}
                   7471: 
1.964     droeschl 7472:     # Don't add anything more if only_body wanted or in const space
                   7473:     return $result if    $args->{'only_body'} 
                   7474:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7475: 
                   7476:     #Breadcrumbs
1.758     kaisler  7477:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7478: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7479: 		#if any br links exists, add them to the breadcrumbs
                   7480: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7481: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7482: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7483: 			}
                   7484: 		}
1.1075.2.19  raeburn  7485:                 # if @advtools array contains items add then to the breadcrumbs
                   7486:                 if (@advtools > 0) {
                   7487:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7488:                 }
1.758     kaisler  7489: 
                   7490: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7491: 		if(exists($args->{'bread_crumbs_component'})){
                   7492: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7493: 		}else{
                   7494: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7495: 		}
1.1075.2.24  raeburn  7496:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7497:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7498:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7499:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7500:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7501:     }
1.315     albertel 7502:     return $result;
1.306     albertel 7503: }
                   7504: 
                   7505: sub end_page {
1.315     albertel 7506:     my ($args) = @_;
                   7507:     $env{'internal.end_page'}++;
1.330     albertel 7508:     my $result;
1.335     albertel 7509:     if ($args->{'discussion'}) {
                   7510: 	my ($target,$parser);
                   7511: 	if (ref($args->{'discussion'})) {
                   7512: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7513: 				$args->{'discussion'}{'parser'});
                   7514: 	}
                   7515: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7516:     }
1.330     albertel 7517:     if ($args->{'frameset'}) {
                   7518: 	$result .= '</frameset>';
                   7519:     } else {
1.635     raeburn  7520: 	$result .= &endbodytag($args);
1.330     albertel 7521:     }
1.1075.2.6  raeburn  7522:     unless ($args->{'notbody'}) {
                   7523:         $result .= "\n</html>";
                   7524:     }
1.330     albertel 7525: 
1.315     albertel 7526:     if ($args->{'js_ready'}) {
1.317     albertel 7527: 	$result = &js_ready($result);
1.315     albertel 7528:     }
1.335     albertel 7529: 
1.320     albertel 7530:     if ($args->{'html_encode'}) {
                   7531: 	$result = &html_encode($result);
                   7532:     }
1.335     albertel 7533: 
1.315     albertel 7534:     return $result;
                   7535: }
                   7536: 
1.1034    www      7537: sub wishlist_window {
                   7538:     return(<<'ENDWISHLIST');
1.1046    raeburn  7539: <script type="text/javascript">
1.1034    www      7540: // <![CDATA[
                   7541: // <!-- BEGIN LON-CAPA Internal
                   7542: function set_wishlistlink(title, path) {
                   7543:     if (!title) {
                   7544:         title = document.title;
                   7545:         title = title.replace(/^LON-CAPA /,'');
                   7546:     }
                   7547:     if (!path) {
                   7548:         path = location.pathname;
                   7549:     }
                   7550:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7551:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7552: }
                   7553: // END LON-CAPA Internal -->
                   7554: // ]]>
                   7555: </script>
                   7556: ENDWISHLIST
                   7557: }
                   7558: 
1.1030    www      7559: sub modal_window {
                   7560:     return(<<'ENDMODAL');
1.1046    raeburn  7561: <script type="text/javascript">
1.1030    www      7562: // <![CDATA[
                   7563: // <!-- BEGIN LON-CAPA Internal
                   7564: var modalWindow = {
                   7565: 	parent:"body",
                   7566: 	windowId:null,
                   7567: 	content:null,
                   7568: 	width:null,
                   7569: 	height:null,
                   7570: 	close:function()
                   7571: 	{
                   7572: 	        $(".LCmodal-window").remove();
                   7573: 	        $(".LCmodal-overlay").remove();
                   7574: 	},
                   7575: 	open:function()
                   7576: 	{
                   7577: 		var modal = "";
                   7578: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7579: 		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;\">";
                   7580: 		modal += this.content;
                   7581: 		modal += "</div>";	
                   7582: 
                   7583: 		$(this.parent).append(modal);
                   7584: 
                   7585: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7586: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7587: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7588: 	}
                   7589: };
1.1031    www      7590: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7591: 	{
                   7592: 		modalWindow.windowId = "myModal";
                   7593: 		modalWindow.width = width;
                   7594: 		modalWindow.height = height;
1.1031    www      7595: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7596: 		modalWindow.open();
                   7597: 	};	
                   7598: // END LON-CAPA Internal -->
                   7599: // ]]>
                   7600: </script>
                   7601: ENDMODAL
                   7602: }
                   7603: 
                   7604: sub modal_link {
1.1052    www      7605:     my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030    www      7606:     unless ($width) { $width=480; }
                   7607:     unless ($height) { $height=400; }
1.1031    www      7608:     unless ($scrolling) { $scrolling='yes'; }
1.1074    raeburn  7609:     my $target_attr;
                   7610:     if (defined($target)) {
                   7611:         $target_attr = 'target="'.$target.'"';
                   7612:     }
                   7613:     return <<"ENDLINK";
                   7614: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
                   7615:            $linktext</a>
                   7616: ENDLINK
1.1030    www      7617: }
                   7618: 
1.1032    www      7619: sub modal_adhoc_script {
                   7620:     my ($funcname,$width,$height,$content)=@_;
                   7621:     return (<<ENDADHOC);
1.1046    raeburn  7622: <script type="text/javascript">
1.1032    www      7623: // <![CDATA[
                   7624:         var $funcname = function()
                   7625:         {
                   7626:                 modalWindow.windowId = "myModal";
                   7627:                 modalWindow.width = $width;
                   7628:                 modalWindow.height = $height;
                   7629:                 modalWindow.content = '$content';
                   7630:                 modalWindow.open();
                   7631:         };  
                   7632: // ]]>
                   7633: </script>
                   7634: ENDADHOC
                   7635: }
                   7636: 
1.1041    www      7637: sub modal_adhoc_inner {
                   7638:     my ($funcname,$width,$height,$content)=@_;
                   7639:     my $innerwidth=$width-20;
                   7640:     $content=&js_ready(
1.1042    www      7641:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041    www      7642:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
                   7643:                     $content.
                   7644:                  &end_scrollbox().
                   7645:                &end_page()
                   7646:              );
                   7647:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7648: }
                   7649: 
                   7650: sub modal_adhoc_window {
                   7651:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7652:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7653:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7654: }
                   7655: 
                   7656: sub modal_adhoc_launch {
                   7657:     my ($funcname,$width,$height,$content)=@_;
                   7658:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7659: <script type="text/javascript">
                   7660: // <![CDATA[
                   7661: $funcname();
                   7662: // ]]>
                   7663: </script>
                   7664: ENDLAUNCH
                   7665: }
                   7666: 
                   7667: sub modal_adhoc_close {
                   7668:     return (<<ENDCLOSE);
                   7669: <script type="text/javascript">
                   7670: // <![CDATA[
                   7671: modalWindow.close();
                   7672: // ]]>
                   7673: </script>
                   7674: ENDCLOSE
                   7675: }
                   7676: 
1.1038    www      7677: sub togglebox_script {
                   7678:    return(<<ENDTOGGLE);
                   7679: <script type="text/javascript"> 
                   7680: // <![CDATA[
                   7681: function LCtoggleDisplay(id,hidetext,showtext) {
                   7682:    link = document.getElementById(id + "link").childNodes[0];
                   7683:    with (document.getElementById(id).style) {
                   7684:       if (display == "none" ) {
                   7685:           display = "inline";
                   7686:           link.nodeValue = hidetext;
                   7687:         } else {
                   7688:           display = "none";
                   7689:           link.nodeValue = showtext;
                   7690:        }
                   7691:    }
                   7692: }
                   7693: // ]]>
                   7694: </script>
                   7695: ENDTOGGLE
                   7696: }
                   7697: 
1.1039    www      7698: sub start_togglebox {
                   7699:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7700:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7701:     unless ($showtext) { $showtext=&mt('show'); }
                   7702:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7703:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7704:     return &start_data_table().
                   7705:            &start_data_table_header_row().
                   7706:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7707:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7708:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7709:            &end_data_table_header_row().
                   7710:            '<tr id="'.$id.'" style="display:none""><td>';
                   7711: }
                   7712: 
                   7713: sub end_togglebox {
                   7714:     return '</td></tr>'.&end_data_table();
                   7715: }
                   7716: 
1.1041    www      7717: sub LCprogressbar_script {
1.1045    www      7718:    my ($id)=@_;
1.1041    www      7719:    return(<<ENDPROGRESS);
                   7720: <script type="text/javascript">
                   7721: // <![CDATA[
1.1045    www      7722: \$('#progressbar$id').progressbar({
1.1041    www      7723:   value: 0,
                   7724:   change: function(event, ui) {
                   7725:     var newVal = \$(this).progressbar('option', 'value');
                   7726:     \$('.pblabel', this).text(LCprogressTxt);
                   7727:   }
                   7728: });
                   7729: // ]]>
                   7730: </script>
                   7731: ENDPROGRESS
                   7732: }
                   7733: 
                   7734: sub LCprogressbarUpdate_script {
                   7735:    return(<<ENDPROGRESSUPDATE);
                   7736: <style type="text/css">
                   7737: .ui-progressbar { position:relative; }
                   7738: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7739: </style>
                   7740: <script type="text/javascript">
                   7741: // <![CDATA[
1.1045    www      7742: var LCprogressTxt='---';
                   7743: 
                   7744: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7745:    LCprogressTxt=progresstext;
1.1045    www      7746:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7747: }
                   7748: // ]]>
                   7749: </script>
                   7750: ENDPROGRESSUPDATE
                   7751: }
                   7752: 
1.1042    www      7753: my $LClastpercent;
1.1045    www      7754: my $LCidcnt;
                   7755: my $LCcurrentid;
1.1042    www      7756: 
1.1041    www      7757: sub LCprogressbar {
1.1042    www      7758:     my ($r)=(@_);
                   7759:     $LClastpercent=0;
1.1045    www      7760:     $LCidcnt++;
                   7761:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7762:     my $starting=&mt('Starting');
                   7763:     my $content=(<<ENDPROGBAR);
                   7764: <p>
1.1045    www      7765:   <div id="progressbar$LCcurrentid">
1.1041    www      7766:     <span class="pblabel">$starting</span>
                   7767:   </div>
                   7768: </p>
                   7769: ENDPROGBAR
1.1045    www      7770:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7771: }
                   7772: 
                   7773: sub LCprogressbarUpdate {
1.1042    www      7774:     my ($r,$val,$text)=@_;
                   7775:     unless ($val) { 
                   7776:        if ($LClastpercent) {
                   7777:            $val=$LClastpercent;
                   7778:        } else {
                   7779:            $val=0;
                   7780:        }
                   7781:     }
1.1041    www      7782:     if ($val<0) { $val=0; }
                   7783:     if ($val>100) { $val=0; }
1.1042    www      7784:     $LClastpercent=$val;
1.1041    www      7785:     unless ($text) { $text=$val.'%'; }
                   7786:     $text=&js_ready($text);
1.1044    www      7787:     &r_print($r,<<ENDUPDATE);
1.1041    www      7788: <script type="text/javascript">
                   7789: // <![CDATA[
1.1045    www      7790: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7791: // ]]>
                   7792: </script>
                   7793: ENDUPDATE
1.1035    www      7794: }
                   7795: 
1.1042    www      7796: sub LCprogressbarClose {
                   7797:     my ($r)=@_;
                   7798:     $LClastpercent=0;
1.1044    www      7799:     &r_print($r,<<ENDCLOSE);
1.1042    www      7800: <script type="text/javascript">
                   7801: // <![CDATA[
1.1045    www      7802: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7803: // ]]>
                   7804: </script>
                   7805: ENDCLOSE
1.1044    www      7806: }
                   7807: 
                   7808: sub r_print {
                   7809:     my ($r,$to_print)=@_;
                   7810:     if ($r) {
                   7811:       $r->print($to_print);
                   7812:       $r->rflush();
                   7813:     } else {
                   7814:       print($to_print);
                   7815:     }
1.1042    www      7816: }
                   7817: 
1.320     albertel 7818: sub html_encode {
                   7819:     my ($result) = @_;
                   7820: 
1.322     albertel 7821:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7822:     
                   7823:     return $result;
                   7824: }
1.1044    www      7825: 
1.317     albertel 7826: sub js_ready {
                   7827:     my ($result) = @_;
                   7828: 
1.323     albertel 7829:     $result =~ s/[\n\r]/ /xmsg;
                   7830:     $result =~ s/\\/\\\\/xmsg;
                   7831:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7832:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7833:     
                   7834:     return $result;
                   7835: }
                   7836: 
1.315     albertel 7837: sub validate_page {
                   7838:     if (  exists($env{'internal.start_page'})
1.316     albertel 7839: 	  &&     $env{'internal.start_page'} > 1) {
                   7840: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7841: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7842: 				 $ENV{'request.filename'});
1.315     albertel 7843:     }
                   7844:     if (  exists($env{'internal.end_page'})
1.316     albertel 7845: 	  &&     $env{'internal.end_page'} > 1) {
                   7846: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7847: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7848: 				 $env{'request.filename'});
1.315     albertel 7849:     }
                   7850:     if (     exists($env{'internal.start_page'})
                   7851: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7852: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7853: 				 $env{'request.filename'});
1.315     albertel 7854:     }
                   7855:     if (   ! exists($env{'internal.start_page'})
                   7856: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7857: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7858: 				 $env{'request.filename'});
1.315     albertel 7859:     }
1.306     albertel 7860: }
1.315     albertel 7861: 
1.996     www      7862: 
                   7863: sub start_scrollbox {
1.1075    raeburn  7864:     my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998     raeburn  7865:     unless ($outerwidth) { $outerwidth='520px'; }
                   7866:     unless ($width) { $width='500px'; }
                   7867:     unless ($height) { $height='200px'; }
1.1075    raeburn  7868:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7869:     if ($id ne '') {
1.1020    raeburn  7870:         $table_id = " id='table_$id'";
                   7871:         $div_id = " id='div_$id'";
1.1018    raeburn  7872:     }
1.1075    raeburn  7873:     if ($bgcolor ne '') {
                   7874:         $tdcol = "background-color: $bgcolor;";
                   7875:     }
                   7876:     return <<"END";
                   7877: <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>
                   7878: END
1.996     www      7879: }
                   7880: 
                   7881: sub end_scrollbox {
1.1036    www      7882:     return '</div></td></tr></table>';
1.996     www      7883: }
                   7884: 
1.318     albertel 7885: sub simple_error_page {
                   7886:     my ($r,$title,$msg) = @_;
                   7887:     my $page =
                   7888: 	&Apache::loncommon::start_page($title).
1.1075.2.15  raeburn  7889: 	'<p class="LC_error">'.&mt($msg).'</p>'.
1.318     albertel 7890: 	&Apache::loncommon::end_page();
                   7891:     if (ref($r)) {
                   7892: 	$r->print($page);
1.327     albertel 7893: 	return;
1.318     albertel 7894:     }
                   7895:     return $page;
                   7896: }
1.347     albertel 7897: 
                   7898: {
1.610     albertel 7899:     my @row_count;
1.961     onken    7900: 
                   7901:     sub start_data_table_count {
                   7902:         unshift(@row_count, 0);
                   7903:         return;
                   7904:     }
                   7905: 
                   7906:     sub end_data_table_count {
                   7907:         shift(@row_count);
                   7908:         return;
                   7909:     }
                   7910: 
1.347     albertel 7911:     sub start_data_table {
1.1018    raeburn  7912: 	my ($add_class,$id) = @_;
1.422     albertel 7913: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7914:         my $table_id;
                   7915:         if (defined($id)) {
                   7916:             $table_id = ' id="'.$id.'"';
                   7917:         }
1.961     onken    7918: 	&start_data_table_count();
1.1018    raeburn  7919: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7920:     }
                   7921: 
                   7922:     sub end_data_table {
1.961     onken    7923: 	&end_data_table_count();
1.389     albertel 7924: 	return '</table>'."\n";;
1.347     albertel 7925:     }
                   7926: 
                   7927:     sub start_data_table_row {
1.974     wenzelju 7928: 	my ($add_class, $id) = @_;
1.610     albertel 7929: 	$row_count[0]++;
                   7930: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7931: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7932:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7933:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7934:     }
1.471     banghart 7935:     
                   7936:     sub continue_data_table_row {
1.974     wenzelju 7937: 	my ($add_class, $id) = @_;
1.610     albertel 7938: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7939: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7940:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7941:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7942:     }
1.347     albertel 7943: 
                   7944:     sub end_data_table_row {
1.389     albertel 7945: 	return '</tr>'."\n";;
1.347     albertel 7946:     }
1.367     www      7947: 
1.421     albertel 7948:     sub start_data_table_empty_row {
1.707     bisitz   7949: #	$row_count[0]++;
1.421     albertel 7950: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7951:     }
                   7952: 
                   7953:     sub end_data_table_empty_row {
                   7954: 	return '</tr>'."\n";;
                   7955:     }
                   7956: 
1.367     www      7957:     sub start_data_table_header_row {
1.389     albertel 7958: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7959:     }
                   7960: 
                   7961:     sub end_data_table_header_row {
1.389     albertel 7962: 	return '</tr>'."\n";;
1.367     www      7963:     }
1.890     droeschl 7964: 
                   7965:     sub data_table_caption {
                   7966:         my $caption = shift;
                   7967:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7968:     }
1.347     albertel 7969: }
                   7970: 
1.548     albertel 7971: =pod
                   7972: 
                   7973: =item * &inhibit_menu_check($arg)
                   7974: 
                   7975: Checks for a inhibitmenu state and generates output to preserve it
                   7976: 
                   7977: Inputs:         $arg - can be any of
                   7978:                      - undef - in which case the return value is a string 
                   7979:                                to add  into arguments list of a uri
                   7980:                      - 'input' - in which case the return value is a HTML
                   7981:                                  <form> <input> field of type hidden to
                   7982:                                  preserve the value
                   7983:                      - a url - in which case the return value is the url with
                   7984:                                the neccesary cgi args added to preserve the
                   7985:                                inhibitmenu state
                   7986:                      - a ref to a url - no return value, but the string is
                   7987:                                         updated to include the neccessary cgi
                   7988:                                         args to preserve the inhibitmenu state
                   7989: 
                   7990: =cut
                   7991: 
                   7992: sub inhibit_menu_check {
                   7993:     my ($arg) = @_;
                   7994:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7995:     if ($arg eq 'input') {
                   7996: 	if ($env{'form.inhibitmenu'}) {
                   7997: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7998: 	} else {
                   7999: 	    return
                   8000: 	}
                   8001:     }
                   8002:     if ($env{'form.inhibitmenu'}) {
                   8003: 	if (ref($arg)) {
                   8004: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8005: 	} elsif ($arg eq '') {
                   8006: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8007: 	} else {
                   8008: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8009: 	}
                   8010:     }
                   8011:     if (!ref($arg)) {
                   8012: 	return $arg;
                   8013:     }
                   8014: }
                   8015: 
1.251     albertel 8016: ###############################################
1.182     matthew  8017: 
                   8018: =pod
                   8019: 
1.549     albertel 8020: =back
                   8021: 
                   8022: =head1 User Information Routines
                   8023: 
                   8024: =over 4
                   8025: 
1.405     albertel 8026: =item * &get_users_function()
1.182     matthew  8027: 
                   8028: Used by &bodytag to determine the current users primary role.
                   8029: Returns either 'student','coordinator','admin', or 'author'.
                   8030: 
                   8031: =cut
                   8032: 
                   8033: ###############################################
                   8034: sub get_users_function {
1.815     tempelho 8035:     my $function = 'norole';
1.818     tempelho 8036:     if ($env{'request.role'}=~/^(st)/) {
                   8037:         $function='student';
                   8038:     }
1.907     raeburn  8039:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8040:         $function='coordinator';
                   8041:     }
1.258     albertel 8042:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8043:         $function='admin';
                   8044:     }
1.826     bisitz   8045:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8046:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8047:         $function='author';
                   8048:     }
                   8049:     return $function;
1.54      www      8050: }
1.99      www      8051: 
                   8052: ###############################################
                   8053: 
1.233     raeburn  8054: =pod
                   8055: 
1.821     raeburn  8056: =item * &show_course()
                   8057: 
                   8058: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8059: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8060: 
                   8061: Inputs:
                   8062: None
                   8063: 
                   8064: Outputs:
                   8065: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8066: 
                   8067: =cut
                   8068: 
                   8069: ###############################################
                   8070: sub show_course {
                   8071:     my $course = !$env{'user.adv'};
                   8072:     if (!$env{'user.adv'}) {
                   8073:         foreach my $env (keys(%env)) {
                   8074:             next if ($env !~ m/^user\.priv\./);
                   8075:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8076:                 $course = 0;
                   8077:                 last;
                   8078:             }
                   8079:         }
                   8080:     }
                   8081:     return $course;
                   8082: }
                   8083: 
                   8084: ###############################################
                   8085: 
                   8086: =pod
                   8087: 
1.542     raeburn  8088: =item * &check_user_status()
1.274     raeburn  8089: 
                   8090: Determines current status of supplied role for a
                   8091: specific user. Roles can be active, previous or future.
                   8092: 
                   8093: Inputs: 
                   8094: user's domain, user's username, course's domain,
1.375     raeburn  8095: course's number, optional section ID.
1.274     raeburn  8096: 
                   8097: Outputs:
                   8098: role status: active, previous or future. 
                   8099: 
                   8100: =cut
                   8101: 
                   8102: sub check_user_status {
1.412     raeburn  8103:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8104:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8105:     my @uroles = keys %userinfo;
                   8106:     my $srchstr;
                   8107:     my $active_chk = 'none';
1.412     raeburn  8108:     my $now = time;
1.274     raeburn  8109:     if (@uroles > 0) {
1.908     raeburn  8110:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8111:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8112:         } else {
1.412     raeburn  8113:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8114:         }
                   8115:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8116:             my $role_end = 0;
                   8117:             my $role_start = 0;
                   8118:             $active_chk = 'active';
1.412     raeburn  8119:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8120:                 $role_end = $1;
                   8121:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8122:                     $role_start = $1;
1.274     raeburn  8123:                 }
                   8124:             }
                   8125:             if ($role_start > 0) {
1.412     raeburn  8126:                 if ($now < $role_start) {
1.274     raeburn  8127:                     $active_chk = 'future';
                   8128:                 }
                   8129:             }
                   8130:             if ($role_end > 0) {
1.412     raeburn  8131:                 if ($now > $role_end) {
1.274     raeburn  8132:                     $active_chk = 'previous';
                   8133:                 }
                   8134:             }
                   8135:         }
                   8136:     }
                   8137:     return $active_chk;
                   8138: }
                   8139: 
                   8140: ###############################################
                   8141: 
                   8142: =pod
                   8143: 
1.405     albertel 8144: =item * &get_sections()
1.233     raeburn  8145: 
                   8146: Determines all the sections for a course including
                   8147: sections with students and sections containing other roles.
1.419     raeburn  8148: Incoming parameters: 
                   8149: 
                   8150: 1. domain
                   8151: 2. course number 
                   8152: 3. reference to array containing roles for which sections should 
                   8153: be gathered (optional).
                   8154: 4. reference to array containing status types for which sections 
                   8155: should be gathered (optional).
                   8156: 
                   8157: If the third argument is undefined, sections are gathered for any role. 
                   8158: If the fourth argument is undefined, sections are gathered for any status.
                   8159: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8160:  
1.374     raeburn  8161: Returns section hash (keys are section IDs, values are
                   8162: number of users in each section), subject to the
1.419     raeburn  8163: optional roles filter, optional status filter 
1.233     raeburn  8164: 
                   8165: =cut
                   8166: 
                   8167: ###############################################
                   8168: sub get_sections {
1.419     raeburn  8169:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8170:     if (!defined($cdom) || !defined($cnum)) {
                   8171:         my $cid =  $env{'request.course.id'};
                   8172: 
                   8173: 	return if (!defined($cid));
                   8174: 
                   8175:         $cdom = $env{'course.'.$cid.'.domain'};
                   8176:         $cnum = $env{'course.'.$cid.'.num'};
                   8177:     }
                   8178: 
                   8179:     my %sectioncount;
1.419     raeburn  8180:     my $now = time;
1.240     albertel 8181: 
1.366     albertel 8182:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 8183: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8184: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8185: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8186:         my $start_index = &Apache::loncoursedata::CL_START();
                   8187:         my $end_index = &Apache::loncoursedata::CL_END();
                   8188:         my $status;
1.366     albertel 8189: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8190: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8191: 				                     $data->[$status_index],
                   8192:                                                      $data->[$start_index],
                   8193:                                                      $data->[$end_index]);
                   8194:             if ($stu_status eq 'Active') {
                   8195:                 $status = 'active';
                   8196:             } elsif ($end < $now) {
                   8197:                 $status = 'previous';
                   8198:             } elsif ($start > $now) {
                   8199:                 $status = 'future';
                   8200:             } 
                   8201: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8202:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8203:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8204: 		    $sectioncount{$section}++;
                   8205:                 }
1.240     albertel 8206: 	    }
                   8207: 	}
                   8208:     }
                   8209:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8210:     foreach my $user (sort(keys(%courseroles))) {
                   8211: 	if ($user !~ /^(\w{2})/) { next; }
                   8212: 	my ($role) = ($user =~ /^(\w{2})/);
                   8213: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8214: 	my ($section,$status);
1.240     albertel 8215: 	if ($role eq 'cr' &&
                   8216: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8217: 	    $section=$1;
                   8218: 	}
                   8219: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8220: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8221:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8222:         if ($end == -1 && $start == -1) {
                   8223:             next; #deleted role
                   8224:         }
                   8225:         if (!defined($possible_status)) { 
                   8226:             $sectioncount{$section}++;
                   8227:         } else {
                   8228:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8229:                 $status = 'active';
                   8230:             } elsif ($end < $now) {
                   8231:                 $status = 'future';
                   8232:             } elsif ($start > $now) {
                   8233:                 $status = 'previous';
                   8234:             }
                   8235:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8236:                 $sectioncount{$section}++;
                   8237:             }
                   8238:         }
1.233     raeburn  8239:     }
1.366     albertel 8240:     return %sectioncount;
1.233     raeburn  8241: }
                   8242: 
1.274     raeburn  8243: ###############################################
1.294     raeburn  8244: 
                   8245: =pod
1.405     albertel 8246: 
                   8247: =item * &get_course_users()
                   8248: 
1.275     raeburn  8249: Retrieves usernames:domains for users in the specified course
                   8250: with specific role(s), and access status. 
                   8251: 
                   8252: Incoming parameters:
1.277     albertel 8253: 1. course domain
                   8254: 2. course number
                   8255: 3. access status: users must have - either active, 
1.275     raeburn  8256: previous, future, or all.
1.277     albertel 8257: 4. reference to array of permissible roles
1.288     raeburn  8258: 5. reference to array of section restrictions (optional)
                   8259: 6. reference to results object (hash of hashes).
                   8260: 7. reference to optional userdata hash
1.609     raeburn  8261: 8. reference to optional statushash
1.630     raeburn  8262: 9. flag if privileged users (except those set to unhide in
                   8263:    course settings) should be excluded    
1.609     raeburn  8264: Keys of top level results hash are roles.
1.275     raeburn  8265: Keys of inner hashes are username:domain, with 
                   8266: values set to access type.
1.288     raeburn  8267: Optional userdata hash returns an array with arguments in the 
                   8268: same order as loncoursedata::get_classlist() for student data.
                   8269: 
1.609     raeburn  8270: Optional statushash returns
                   8271: 
1.288     raeburn  8272: Entries for end, start, section and status are blank because
                   8273: of the possibility of multiple values for non-student roles.
                   8274: 
1.275     raeburn  8275: =cut
1.405     albertel 8276: 
1.275     raeburn  8277: ###############################################
1.405     albertel 8278: 
1.275     raeburn  8279: sub get_course_users {
1.630     raeburn  8280:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8281:     my %idx = ();
1.419     raeburn  8282:     my %seclists;
1.288     raeburn  8283: 
                   8284:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8285:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8286:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8287:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8288:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8289:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8290:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8291:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8292: 
1.290     albertel 8293:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8294:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8295:         my $now = time;
1.277     albertel 8296:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8297:             my $match = 0;
1.412     raeburn  8298:             my $secmatch = 0;
1.419     raeburn  8299:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8300:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8301:             if ($section eq '') {
                   8302:                 $section = 'none';
                   8303:             }
1.291     albertel 8304:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8305:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8306:                     $secmatch = 1;
                   8307:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8308:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8309:                         $secmatch = 1;
                   8310:                     }
                   8311:                 } else {  
1.419     raeburn  8312: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8313: 		        $secmatch = 1;
                   8314:                     }
1.290     albertel 8315: 		}
1.412     raeburn  8316:                 if (!$secmatch) {
                   8317:                     next;
                   8318:                 }
1.419     raeburn  8319:             }
1.275     raeburn  8320:             if (defined($$types{'active'})) {
1.288     raeburn  8321:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8322:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8323:                     $match = 1;
1.275     raeburn  8324:                 }
                   8325:             }
                   8326:             if (defined($$types{'previous'})) {
1.609     raeburn  8327:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8328:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8329:                     $match = 1;
1.275     raeburn  8330:                 }
                   8331:             }
                   8332:             if (defined($$types{'future'})) {
1.609     raeburn  8333:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8334:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8335:                     $match = 1;
1.275     raeburn  8336:                 }
                   8337:             }
1.609     raeburn  8338:             if ($match) {
                   8339:                 push(@{$seclists{$student}},$section);
                   8340:                 if (ref($userdata) eq 'HASH') {
                   8341:                     $$userdata{$student} = $$classlist{$student};
                   8342:                 }
                   8343:                 if (ref($statushash) eq 'HASH') {
                   8344:                     $statushash->{$student}{'st'}{$section} = $status;
                   8345:                 }
1.288     raeburn  8346:             }
1.275     raeburn  8347:         }
                   8348:     }
1.412     raeburn  8349:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8350:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8351:         my $now = time;
1.609     raeburn  8352:         my %displaystatus = ( previous => 'Expired',
                   8353:                               active   => 'Active',
                   8354:                               future   => 'Future',
                   8355:                             );
1.630     raeburn  8356:         my %nothide;
                   8357:         if ($hidepriv) {
                   8358:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8359:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8360:                 if ($user !~ /:/) {
                   8361:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8362:                 } else {
                   8363:                     $nothide{$user} = 1;
                   8364:                 }
                   8365:             }
                   8366:         }
1.439     raeburn  8367:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8368:             my $match = 0;
1.412     raeburn  8369:             my $secmatch = 0;
1.439     raeburn  8370:             my $status;
1.412     raeburn  8371:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8372:             $user =~ s/:$//;
1.439     raeburn  8373:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8374:             if ($end == -1 || $start == -1) {
                   8375:                 next;
                   8376:             }
                   8377:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8378:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8379:                 my ($uname,$udom) = split(/:/,$user);
                   8380:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8381:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8382:                         $secmatch = 1;
                   8383:                     } elsif ($usec eq '') {
1.420     albertel 8384:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8385:                             $secmatch = 1;
                   8386:                         }
                   8387:                     } else {
                   8388:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8389:                             $secmatch = 1;
                   8390:                         }
                   8391:                     }
                   8392:                     if (!$secmatch) {
                   8393:                         next;
                   8394:                     }
1.288     raeburn  8395:                 }
1.419     raeburn  8396:                 if ($usec eq '') {
                   8397:                     $usec = 'none';
                   8398:                 }
1.275     raeburn  8399:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8400:                     if ($hidepriv) {
                   8401:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   8402:                             (!$nothide{$uname.':'.$udom})) {
                   8403:                             next;
                   8404:                         }
                   8405:                     }
1.503     raeburn  8406:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8407:                         $status = 'previous';
                   8408:                     } elsif ($start > $now) {
                   8409:                         $status = 'future';
                   8410:                     } else {
                   8411:                         $status = 'active';
                   8412:                     }
1.277     albertel 8413:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8414:                         if ($status eq $type) {
1.420     albertel 8415:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8416:                                 push(@{$$users{$role}{$user}},$type);
                   8417:                             }
1.288     raeburn  8418:                             $match = 1;
                   8419:                         }
                   8420:                     }
1.419     raeburn  8421:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8422:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8423: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8424:                         }
1.420     albertel 8425:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8426:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8427:                         }
1.609     raeburn  8428:                         if (ref($statushash) eq 'HASH') {
                   8429:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8430:                         }
1.275     raeburn  8431:                     }
                   8432:                 }
                   8433:             }
                   8434:         }
1.290     albertel 8435:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8436:             if ((defined($cdom)) && (defined($cnum))) {
                   8437:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8438:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8439:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8440:                     next if ($owner eq '');
                   8441:                     my ($ownername,$ownerdom);
                   8442:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8443:                         $ownername = $1;
                   8444:                         $ownerdom = $2;
                   8445:                     } else {
                   8446:                         $ownername = $owner;
                   8447:                         $ownerdom = $cdom;
                   8448:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8449:                     }
                   8450:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8451:                     if (defined($userdata) && 
1.609     raeburn  8452: 			!exists($$userdata{$owner})) {
                   8453: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8454:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8455:                             push(@{$seclists{$owner}},'none');
                   8456:                         }
                   8457:                         if (ref($statushash) eq 'HASH') {
                   8458:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8459:                         }
1.290     albertel 8460: 		    }
1.279     raeburn  8461:                 }
                   8462:             }
                   8463:         }
1.419     raeburn  8464:         foreach my $user (keys(%seclists)) {
                   8465:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8466:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8467:         }
1.275     raeburn  8468:     }
                   8469:     return;
                   8470: }
                   8471: 
1.288     raeburn  8472: sub get_user_info {
                   8473:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8474:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8475: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8476:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8477:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8478:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8479:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8480:     return;
                   8481: }
1.275     raeburn  8482: 
1.472     raeburn  8483: ###############################################
                   8484: 
                   8485: =pod
                   8486: 
                   8487: =item * &get_user_quota()
                   8488: 
                   8489: Retrieves quota assigned for storage of portfolio files for a user  
                   8490: 
                   8491: Incoming parameters:
                   8492: 1. user's username
                   8493: 2. user's domain
                   8494: 
                   8495: Returns:
1.536     raeburn  8496: 1. Disk quota (in Mb) assigned to student.
                   8497: 2. (Optional) Type of setting: custom or default
                   8498:    (individually assigned or default for user's 
                   8499:    institutional status).
                   8500: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8501:    or student - types as defined in localenroll::inst_usertypes 
                   8502:    for user's domain, which determines default quota for user.
                   8503: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8504: 
                   8505: If a value has been stored in the user's environment, 
1.536     raeburn  8506: it will return that, otherwise it returns the maximal default
                   8507: defined for the user's instituional status(es) in the domain.
1.472     raeburn  8508: 
                   8509: =cut
                   8510: 
                   8511: ###############################################
                   8512: 
                   8513: 
                   8514: sub get_user_quota {
                   8515:     my ($uname,$udom) = @_;
1.536     raeburn  8516:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8517:     if (!defined($udom)) {
                   8518:         $udom = $env{'user.domain'};
                   8519:     }
                   8520:     if (!defined($uname)) {
                   8521:         $uname = $env{'user.name'};
                   8522:     }
                   8523:     if (($udom eq '' || $uname eq '') ||
                   8524:         ($udom eq 'public') && ($uname eq 'public')) {
                   8525:         $quota = 0;
1.536     raeburn  8526:         $quotatype = 'default';
                   8527:         $defquota = 0; 
1.472     raeburn  8528:     } else {
1.536     raeburn  8529:         my $inststatus;
1.472     raeburn  8530:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8531:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  8532:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  8533:         } else {
1.536     raeburn  8534:             my %userenv = 
                   8535:                 &Apache::lonnet::get('environment',['portfolioquota',
                   8536:                                      'inststatus'],$udom,$uname);
1.472     raeburn  8537:             my ($tmp) = keys(%userenv);
                   8538:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8539:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  8540:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  8541:             } else {
                   8542:                 undef(%userenv);
                   8543:             }
                   8544:         }
1.536     raeburn  8545:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  8546:         if ($quota eq '') {
1.536     raeburn  8547:             $quota = $defquota;
                   8548:             $quotatype = 'default';
                   8549:         } else {
                   8550:             $quotatype = 'custom';
1.472     raeburn  8551:         }
                   8552:     }
1.536     raeburn  8553:     if (wantarray) {
                   8554:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8555:     } else {
                   8556:         return $quota;
                   8557:     }
1.472     raeburn  8558: }
                   8559: 
                   8560: ###############################################
                   8561: 
                   8562: =pod
                   8563: 
                   8564: =item * &default_quota()
                   8565: 
1.536     raeburn  8566: Retrieves default quota assigned for storage of user portfolio files,
                   8567: given an (optional) user's institutional status.
1.472     raeburn  8568: 
                   8569: Incoming parameters:
                   8570: 1. domain
1.536     raeburn  8571: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8572:    status types (e.g., faculty, staff, student etc.)
                   8573:    which apply to the user for whom the default is being retrieved.
                   8574:    If the institutional status string in undefined, the domain
                   8575:    default quota will be returned. 
1.472     raeburn  8576: 
                   8577: Returns:
                   8578: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8579: 2. (Optional) institutional type which determined the value of the
                   8580:    default quota.
1.472     raeburn  8581: 
                   8582: If a value has been stored in the domain's configuration db,
                   8583: it will return that, otherwise it returns 20 (for backwards 
                   8584: compatibility with domains which have not set up a configuration
                   8585: db file; the original statically defined portfolio quota was 20 Mb). 
                   8586: 
1.536     raeburn  8587: If the user's status includes multiple types (e.g., staff and student),
                   8588: the largest default quota which applies to the user determines the
                   8589: default quota returned.
                   8590: 
1.780     raeburn  8591: =back
                   8592: 
1.472     raeburn  8593: =cut
                   8594: 
                   8595: ###############################################
                   8596: 
                   8597: 
                   8598: sub default_quota {
1.536     raeburn  8599:     my ($udom,$inststatus) = @_;
                   8600:     my ($defquota,$settingstatus);
                   8601:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8602:                                             ['quotas'],$udom);
                   8603:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8604:         if ($inststatus ne '') {
1.765     raeburn  8605:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8606:             foreach my $item (@statuses) {
1.711     raeburn  8607:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8608:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   8609:                         if ($defquota eq '') {
                   8610:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8611:                             $settingstatus = $item;
                   8612:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   8613:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8614:                             $settingstatus = $item;
                   8615:                         }
                   8616:                     }
                   8617:                 } else {
                   8618:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8619:                         if ($defquota eq '') {
                   8620:                             $defquota = $quotahash{'quotas'}{$item};
                   8621:                             $settingstatus = $item;
                   8622:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8623:                             $defquota = $quotahash{'quotas'}{$item};
                   8624:                             $settingstatus = $item;
                   8625:                         }
1.536     raeburn  8626:                     }
                   8627:                 }
                   8628:             }
                   8629:         }
                   8630:         if ($defquota eq '') {
1.711     raeburn  8631:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8632:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   8633:             } else {
                   8634:                 $defquota = $quotahash{'quotas'}{'default'};
                   8635:             }
1.536     raeburn  8636:             $settingstatus = 'default';
                   8637:         }
                   8638:     } else {
                   8639:         $settingstatus = 'default';
                   8640:         $defquota = 20;
                   8641:     }
                   8642:     if (wantarray) {
                   8643:         return ($defquota,$settingstatus);
1.472     raeburn  8644:     } else {
1.536     raeburn  8645:         return $defquota;
1.472     raeburn  8646:     }
                   8647: }
                   8648: 
1.384     raeburn  8649: sub get_secgrprole_info {
                   8650:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8651:     my %sections_count = &get_sections($cdom,$cnum);
                   8652:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8653:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8654:     my @groups = sort(keys(%curr_groups));
                   8655:     my $allroles = [];
                   8656:     my $rolehash;
                   8657:     my $accesshash = {
                   8658:                      active => 'Currently has access',
                   8659:                      future => 'Will have future access',
                   8660:                      previous => 'Previously had access',
                   8661:                   };
                   8662:     if ($needroles) {
                   8663:         $rolehash = {'all' => 'all'};
1.385     albertel 8664:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8665: 	if (&Apache::lonnet::error(%user_roles)) {
                   8666: 	    undef(%user_roles);
                   8667: 	}
                   8668:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8669:             my ($role)=split(/\:/,$item,2);
                   8670:             if ($role eq 'cr') { next; }
                   8671:             if ($role =~ /^cr/) {
                   8672:                 $$rolehash{$role} = (split('/',$role))[3];
                   8673:             } else {
                   8674:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8675:             }
                   8676:         }
                   8677:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8678:             push(@{$allroles},$key);
                   8679:         }
                   8680:         push (@{$allroles},'st');
                   8681:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8682:     }
                   8683:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8684: }
                   8685: 
1.555     raeburn  8686: sub user_picker {
1.994     raeburn  8687:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8688:     my $currdom = $dom;
                   8689:     my %curr_selected = (
                   8690:                         srchin => 'dom',
1.580     raeburn  8691:                         srchby => 'lastname',
1.555     raeburn  8692:                       );
                   8693:     my $srchterm;
1.625     raeburn  8694:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8695:         if ($srch->{'srchby'} ne '') {
                   8696:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8697:         }
                   8698:         if ($srch->{'srchin'} ne '') {
                   8699:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8700:         }
                   8701:         if ($srch->{'srchtype'} ne '') {
                   8702:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8703:         }
                   8704:         if ($srch->{'srchdomain'} ne '') {
                   8705:             $currdom = $srch->{'srchdomain'};
                   8706:         }
                   8707:         $srchterm = $srch->{'srchterm'};
                   8708:     }
                   8709:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8710:                     'usr'       => 'Search criteria',
1.563     raeburn  8711:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8712:                     'uname'     => 'username',
                   8713:                     'lastname'  => 'last name',
1.555     raeburn  8714:                     'lastfirst' => 'last name, first name',
1.558     albertel 8715:                     'crs'       => 'in this course',
1.576     raeburn  8716:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8717:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8718:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8719:                     'exact'     => 'is',
                   8720:                     'contains'  => 'contains',
1.569     raeburn  8721:                     'begins'    => 'begins with',
1.571     raeburn  8722:                     'youm'      => "You must include some text to search for.",
                   8723:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8724:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8725:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8726:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8727:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8728:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8729:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8730:                                        );
1.563     raeburn  8731:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8732:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8733: 
                   8734:     my @srchins = ('crs','dom','alc','instd');
                   8735: 
                   8736:     foreach my $option (@srchins) {
                   8737:         # FIXME 'alc' option unavailable until 
                   8738:         #       loncreateuser::print_user_query_page()
                   8739:         #       has been completed.
                   8740:         next if ($option eq 'alc');
1.880     raeburn  8741:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8742:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8743:         if ($curr_selected{'srchin'} eq $option) {
                   8744:             $srchinsel .= ' 
                   8745:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8746:         } else {
                   8747:             $srchinsel .= '
                   8748:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8749:         }
1.555     raeburn  8750:     }
1.563     raeburn  8751:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8752: 
                   8753:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8754:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8755:         if ($curr_selected{'srchby'} eq $option) {
                   8756:             $srchbysel .= '
                   8757:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8758:         } else {
                   8759:             $srchbysel .= '
                   8760:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8761:          }
                   8762:     }
                   8763:     $srchbysel .= "\n  </select>\n";
                   8764: 
                   8765:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8766:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8767:         if ($curr_selected{'srchtype'} eq $option) {
                   8768:             $srchtypesel .= '
                   8769:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8770:         } else {
                   8771:             $srchtypesel .= '
                   8772:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8773:         }
                   8774:     }
                   8775:     $srchtypesel .= "\n  </select>\n";
                   8776: 
1.558     albertel 8777:     my ($newuserscript,$new_user_create);
1.994     raeburn  8778:     my $context_dom = $env{'request.role.domain'};
                   8779:     if ($context eq 'requestcrs') {
                   8780:         if ($env{'form.coursedom'} ne '') { 
                   8781:             $context_dom = $env{'form.coursedom'};
                   8782:         }
                   8783:     }
1.556     raeburn  8784:     if ($forcenewuser) {
1.576     raeburn  8785:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8786:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8787:                 if ($cancreate) {
                   8788:                     $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>';
                   8789:                 } else {
1.799     bisitz   8790:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8791:                     my %usertypetext = (
                   8792:                         official   => 'institutional',
                   8793:                         unofficial => 'non-institutional',
                   8794:                     );
1.799     bisitz   8795:                     $new_user_create = '<p class="LC_warning">'
                   8796:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8797:                                       .' '
                   8798:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8799:                                           ,'<a href="'.$helplink.'">','</a>')
                   8800:                                       .'</p><br />';
1.627     raeburn  8801:                 }
1.576     raeburn  8802:             }
                   8803:         }
                   8804: 
1.556     raeburn  8805:         $newuserscript = <<"ENDSCRIPT";
                   8806: 
1.570     raeburn  8807: function setSearch(createnew,callingForm) {
1.556     raeburn  8808:     if (createnew == 1) {
1.570     raeburn  8809:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8810:             if (callingForm.srchby.options[i].value == 'uname') {
                   8811:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8812:             }
                   8813:         }
1.570     raeburn  8814:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8815:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8816: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8817:             }
                   8818:         }
1.570     raeburn  8819:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8820:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8821:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8822:             }
                   8823:         }
1.570     raeburn  8824:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8825:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8826:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8827:             }
                   8828:         }
                   8829:     }
                   8830: }
                   8831: ENDSCRIPT
1.558     albertel 8832: 
1.556     raeburn  8833:     }
                   8834: 
1.555     raeburn  8835:     my $output = <<"END_BLOCK";
1.556     raeburn  8836: <script type="text/javascript">
1.824     bisitz   8837: // <![CDATA[
1.570     raeburn  8838: function validateEntry(callingForm) {
1.558     albertel 8839: 
1.556     raeburn  8840:     var checkok = 1;
1.558     albertel 8841:     var srchin;
1.570     raeburn  8842:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8843: 	if ( callingForm.srchin[i].checked ) {
                   8844: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8845: 	}
                   8846:     }
                   8847: 
1.570     raeburn  8848:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8849:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8850:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8851:     var srchterm =  callingForm.srchterm.value;
                   8852:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8853:     var msg = "";
                   8854: 
                   8855:     if (srchterm == "") {
                   8856:         checkok = 0;
1.571     raeburn  8857:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8858:     }
                   8859: 
1.569     raeburn  8860:     if (srchtype== 'begins') {
                   8861:         if (srchterm.length < 2) {
                   8862:             checkok = 0;
1.571     raeburn  8863:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8864:         }
                   8865:     }
                   8866: 
1.556     raeburn  8867:     if (srchtype== 'contains') {
                   8868:         if (srchterm.length < 3) {
                   8869:             checkok = 0;
1.571     raeburn  8870:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8871:         }
                   8872:     }
                   8873:     if (srchin == 'instd') {
                   8874:         if (srchdomain == '') {
                   8875:             checkok = 0;
1.571     raeburn  8876:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8877:         }
                   8878:     }
                   8879:     if (srchin == 'dom') {
                   8880:         if (srchdomain == '') {
                   8881:             checkok = 0;
1.571     raeburn  8882:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8883:         }
                   8884:     }
                   8885:     if (srchby == 'lastfirst') {
                   8886:         if (srchterm.indexOf(",") == -1) {
                   8887:             checkok = 0;
1.571     raeburn  8888:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8889:         }
                   8890:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8891:             checkok = 0;
1.571     raeburn  8892:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8893:         }
                   8894:     }
                   8895:     if (checkok == 0) {
1.571     raeburn  8896:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8897:         return;
                   8898:     }
                   8899:     if (checkok == 1) {
1.570     raeburn  8900:         callingForm.submit();
1.556     raeburn  8901:     }
                   8902: }
                   8903: 
                   8904: $newuserscript
                   8905: 
1.824     bisitz   8906: // ]]>
1.556     raeburn  8907: </script>
1.558     albertel 8908: 
                   8909: $new_user_create
                   8910: 
1.555     raeburn  8911: END_BLOCK
1.558     albertel 8912: 
1.876     raeburn  8913:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8914:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8915:                $domform.
                   8916:                &Apache::lonhtmlcommon::row_closure().
                   8917:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8918:                $srchbysel.
                   8919:                $srchtypesel. 
                   8920:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8921:                $srchinsel.
                   8922:                &Apache::lonhtmlcommon::row_closure(1). 
                   8923:                &Apache::lonhtmlcommon::end_pick_box().
                   8924:                '<br />';
1.555     raeburn  8925:     return $output;
                   8926: }
                   8927: 
1.612     raeburn  8928: sub user_rule_check {
1.615     raeburn  8929:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8930:     my $response;
                   8931:     if (ref($usershash) eq 'HASH') {
                   8932:         foreach my $user (keys(%{$usershash})) {
                   8933:             my ($uname,$udom) = split(/:/,$user);
                   8934:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8935:             my ($id,$newuser);
1.612     raeburn  8936:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8937:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8938:                 $id = $usershash->{$user}->{'id'};
                   8939:             }
                   8940:             my $inst_response;
                   8941:             if (ref($checks) eq 'HASH') {
                   8942:                 if (defined($checks->{'username'})) {
1.615     raeburn  8943:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8944:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8945:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8946:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8947:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8948:                 }
1.615     raeburn  8949:             } else {
                   8950:                 ($inst_response,%{$inst_results->{$user}}) =
                   8951:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8952:                 return;
1.612     raeburn  8953:             }
1.615     raeburn  8954:             if (!$got_rules->{$udom}) {
1.612     raeburn  8955:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8956:                                                   ['usercreation'],$udom);
                   8957:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8958:                     foreach my $item ('username','id') {
1.612     raeburn  8959:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8960:                             $$curr_rules{$udom}{$item} = 
                   8961:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8962:                         }
                   8963:                     }
                   8964:                 }
1.615     raeburn  8965:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8966:             }
1.612     raeburn  8967:             foreach my $item (keys(%{$checks})) {
                   8968:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8969:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8970:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8971:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8972:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8973:                                 if ($rule_check{$rule}) {
                   8974:                                     $$rulematch{$user}{$item} = $rule;
                   8975:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8976:                                         if (ref($inst_results) eq 'HASH') {
                   8977:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8978:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8979:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8980:                                                 }
1.612     raeburn  8981:                                             }
                   8982:                                         }
1.615     raeburn  8983:                                     }
                   8984:                                     last;
1.585     raeburn  8985:                                 }
                   8986:                             }
                   8987:                         }
                   8988:                     }
                   8989:                 }
                   8990:             }
                   8991:         }
                   8992:     }
1.612     raeburn  8993:     return;
                   8994: }
                   8995: 
                   8996: sub user_rule_formats {
                   8997:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8998:     my %text = ( 
                   8999:                  'username' => 'Usernames',
                   9000:                  'id'       => 'IDs',
                   9001:                );
                   9002:     my $output;
                   9003:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9004:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9005:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9006:             $output = '<br />'.
                   9007:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9008:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9009:                       ' <ul>';
1.612     raeburn  9010:             foreach my $rule (@{$ruleorder}) {
                   9011:                 if (ref($curr_rules) eq 'ARRAY') {
                   9012:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9013:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9014:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9015:                                         $rules->{$rule}{'desc'}.'</li>';
                   9016:                         }
                   9017:                     }
                   9018:                 }
                   9019:             }
                   9020:             $output .= '</ul>';
                   9021:         }
                   9022:     }
                   9023:     return $output;
                   9024: }
                   9025: 
                   9026: sub instrule_disallow_msg {
1.615     raeburn  9027:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9028:     my $response;
                   9029:     my %text = (
                   9030:                   item   => 'username',
                   9031:                   items  => 'usernames',
                   9032:                   match  => 'matches',
                   9033:                   do     => 'does',
                   9034:                   action => 'a username',
                   9035:                   one    => 'one',
                   9036:                );
                   9037:     if ($count > 1) {
                   9038:         $text{'item'} = 'usernames';
                   9039:         $text{'match'} ='match';
                   9040:         $text{'do'} = 'do';
                   9041:         $text{'action'} = 'usernames',
                   9042:         $text{'one'} = 'ones';
                   9043:     }
                   9044:     if ($checkitem eq 'id') {
                   9045:         $text{'items'} = 'IDs';
                   9046:         $text{'item'} = 'ID';
                   9047:         $text{'action'} = 'an ID';
1.615     raeburn  9048:         if ($count > 1) {
                   9049:             $text{'item'} = 'IDs';
                   9050:             $text{'action'} = 'IDs';
                   9051:         }
1.612     raeburn  9052:     }
1.674     bisitz   9053:     $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  9054:     if ($mode eq 'upload') {
                   9055:         if ($checkitem eq 'username') {
                   9056:             $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'}.");
                   9057:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9058:             $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  9059:         }
1.669     raeburn  9060:     } elsif ($mode eq 'selfcreate') {
                   9061:         if ($checkitem eq 'id') {
                   9062:             $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.");
                   9063:         }
1.615     raeburn  9064:     } else {
                   9065:         if ($checkitem eq 'username') {
                   9066:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9067:         } elsif ($checkitem eq 'id') {
                   9068:             $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.");
                   9069:         }
1.612     raeburn  9070:     }
                   9071:     return $response;
1.585     raeburn  9072: }
                   9073: 
1.624     raeburn  9074: sub personal_data_fieldtitles {
                   9075:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9076:                         id => 'Student/Employee ID',
                   9077:                         permanentemail => 'E-mail address',
                   9078:                         lastname => 'Last Name',
                   9079:                         firstname => 'First Name',
                   9080:                         middlename => 'Middle Name',
                   9081:                         generation => 'Generation',
                   9082:                         gen => 'Generation',
1.765     raeburn  9083:                         inststatus => 'Affiliation',
1.624     raeburn  9084:                    );
                   9085:     return %fieldtitles;
                   9086: }
                   9087: 
1.642     raeburn  9088: sub sorted_inst_types {
                   9089:     my ($dom) = @_;
                   9090:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9091:     my $othertitle = &mt('All users');
                   9092:     if ($env{'request.course.id'}) {
1.668     raeburn  9093:         $othertitle  = &mt('Any users');
1.642     raeburn  9094:     }
                   9095:     my @types;
                   9096:     if (ref($order) eq 'ARRAY') {
                   9097:         @types = @{$order};
                   9098:     }
                   9099:     if (@types == 0) {
                   9100:         if (ref($usertypes) eq 'HASH') {
                   9101:             @types = sort(keys(%{$usertypes}));
                   9102:         }
                   9103:     }
                   9104:     if (keys(%{$usertypes}) > 0) {
                   9105:         $othertitle = &mt('Other users');
                   9106:     }
                   9107:     return ($othertitle,$usertypes,\@types);
                   9108: }
                   9109: 
1.645     raeburn  9110: sub get_institutional_codes {
                   9111:     my ($settings,$allcourses,$LC_code) = @_;
                   9112: # Get complete list of course sections to update
                   9113:     my @currsections = ();
                   9114:     my @currxlists = ();
                   9115:     my $coursecode = $$settings{'internal.coursecode'};
                   9116: 
                   9117:     if ($$settings{'internal.sectionnums'} ne '') {
                   9118:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9119:     }
                   9120: 
                   9121:     if ($$settings{'internal.crosslistings'} ne '') {
                   9122:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9123:     }
                   9124: 
                   9125:     if (@currxlists > 0) {
                   9126:         foreach (@currxlists) {
                   9127:             if (m/^([^:]+):(\w*)$/) {
                   9128:                 unless (grep/^$1$/,@{$allcourses}) {
                   9129:                     push @{$allcourses},$1;
                   9130:                     $$LC_code{$1} = $2;
                   9131:                 }
                   9132:             }
                   9133:         }
                   9134:     }
                   9135:  
                   9136:     if (@currsections > 0) {
                   9137:         foreach (@currsections) {
                   9138:             if (m/^(\w+):(\w*)$/) {
                   9139:                 my $sec = $coursecode.$1;
                   9140:                 my $lc_sec = $2;
                   9141:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9142:                     push @{$allcourses},$sec;
                   9143:                     $$LC_code{$sec} = $lc_sec;
                   9144:                 }
                   9145:             }
                   9146:         }
                   9147:     }
                   9148:     return;
                   9149: }
                   9150: 
1.971     raeburn  9151: sub get_standard_codeitems {
                   9152:     return ('Year','Semester','Department','Number','Section');
                   9153: }
                   9154: 
1.112     bowersj2 9155: =pod
                   9156: 
1.780     raeburn  9157: =head1 Slot Helpers
                   9158: 
                   9159: =over 4
                   9160: 
                   9161: =item * sorted_slots()
                   9162: 
1.1040    raeburn  9163: Sorts an array of slot names in order of an optional sort key,
                   9164: default sort is by slot start time (earliest first). 
1.780     raeburn  9165: 
                   9166: Inputs:
                   9167: 
                   9168: =over 4
                   9169: 
                   9170: slotsarr  - Reference to array of unsorted slot names.
                   9171: 
                   9172: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9173: 
1.1040    raeburn  9174: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9175: 
1.549     albertel 9176: =back
                   9177: 
1.780     raeburn  9178: Returns:
                   9179: 
                   9180: =over 4
                   9181: 
1.1040    raeburn  9182: sorted   - An array of slot names sorted by a specified sort key 
                   9183:            (default sort key is start time of the slot).
1.780     raeburn  9184: 
                   9185: =back
                   9186: 
                   9187: =cut
                   9188: 
                   9189: 
                   9190: sub sorted_slots {
1.1040    raeburn  9191:     my ($slotsarr,$slots,$sortkey) = @_;
                   9192:     if ($sortkey eq '') {
                   9193:         $sortkey = 'starttime';
                   9194:     }
1.780     raeburn  9195:     my @sorted;
                   9196:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9197:         @sorted =
                   9198:             sort {
                   9199:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9200:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9201:                      }
                   9202:                      if (ref($slots->{$a})) { return -1;}
                   9203:                      if (ref($slots->{$b})) { return 1;}
                   9204:                      return 0;
                   9205:                  } @{$slotsarr};
                   9206:     }
                   9207:     return @sorted;
                   9208: }
                   9209: 
1.1040    raeburn  9210: =pod
                   9211: 
                   9212: =item * get_future_slots()
                   9213: 
                   9214: Inputs:
                   9215: 
                   9216: =over 4
                   9217: 
                   9218: cnum - course number
                   9219: 
                   9220: cdom - course domain
                   9221: 
                   9222: now - current UNIX time
                   9223: 
                   9224: symb - optional symb
                   9225: 
                   9226: =back
                   9227: 
                   9228: Returns:
                   9229: 
                   9230: =over 4
                   9231: 
                   9232: sorted_reservable - ref to array of student_schedulable slots currently 
                   9233:                     reservable, ordered by end date of reservation period.
                   9234: 
                   9235: reservable_now - ref to hash of student_schedulable slots currently
                   9236:                  reservable.
                   9237: 
                   9238:     Keys in inner hash are:
                   9239:     (a) symb: either blank or symb to which slot use is restricted.
                   9240:     (b) endreserve: end date of reservation period. 
                   9241: 
                   9242: sorted_future - ref to array of student_schedulable slots reservable in
                   9243:                 the future, ordered by start date of reservation period.
                   9244: 
                   9245: future_reservable - ref to hash of student_schedulable slots reservable
                   9246:                     in the future.
                   9247: 
                   9248:     Keys in inner hash are:
                   9249:     (a) symb: either blank or symb to which slot use is restricted.
                   9250:     (b) startreserve:  start date of reservation period.
                   9251: 
                   9252: =back
                   9253: 
                   9254: =cut
                   9255: 
                   9256: sub get_future_slots {
                   9257:     my ($cnum,$cdom,$now,$symb) = @_;
                   9258:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9259:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9260:     foreach my $slot (keys(%slots)) {
                   9261:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9262:         if ($symb) {
                   9263:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9264:                      ($slots{$slot}->{'symb'} ne $symb));
                   9265:         }
                   9266:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9267:             ($slots{$slot}->{'endtime'} > $now)) {
                   9268:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9269:                 my $userallowed = 0;
                   9270:                 if ($slots{$slot}->{'allowedsections'}) {
                   9271:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9272:                     if (!defined($env{'request.role.sec'})
                   9273:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9274:                         $userallowed=1;
                   9275:                     } else {
                   9276:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9277:                             $userallowed=1;
                   9278:                         }
                   9279:                     }
                   9280:                     unless ($userallowed) {
                   9281:                         if (defined($env{'request.course.groups'})) {
                   9282:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9283:                             foreach my $group (@groups) {
                   9284:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9285:                                     $userallowed=1;
                   9286:                                     last;
                   9287:                                 }
                   9288:                             }
                   9289:                         }
                   9290:                     }
                   9291:                 }
                   9292:                 if ($slots{$slot}->{'allowedusers'}) {
                   9293:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9294:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9295:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9296:                         $userallowed = 1;
                   9297:                     }
                   9298:                 }
                   9299:                 next unless($userallowed);
                   9300:             }
                   9301:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9302:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9303:             my $symb = $slots{$slot}->{'symb'};
                   9304:             if (($startreserve < $now) &&
                   9305:                 (!$endreserve || $endreserve > $now)) {
                   9306:                 my $lastres = $endreserve;
                   9307:                 if (!$lastres) {
                   9308:                     $lastres = $slots{$slot}->{'starttime'};
                   9309:                 }
                   9310:                 $reservable_now{$slot} = {
                   9311:                                            symb       => $symb,
                   9312:                                            endreserve => $lastres
                   9313:                                          };
                   9314:             } elsif (($startreserve > $now) &&
                   9315:                      (!$endreserve || $endreserve > $startreserve)) {
                   9316:                 $future_reservable{$slot} = {
                   9317:                                               symb         => $symb,
                   9318:                                               startreserve => $startreserve
                   9319:                                             };
                   9320:             }
                   9321:         }
                   9322:     }
                   9323:     my @unsorted_reservable = keys(%reservable_now);
                   9324:     if (@unsorted_reservable > 0) {
                   9325:         @sorted_reservable = 
                   9326:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9327:     }
                   9328:     my @unsorted_future = keys(%future_reservable);
                   9329:     if (@unsorted_future > 0) {
                   9330:         @sorted_future =
                   9331:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9332:     }
                   9333:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9334: }
1.780     raeburn  9335: 
                   9336: =pod
                   9337: 
1.1057    foxr     9338: =back
                   9339: 
1.549     albertel 9340: =head1 HTTP Helpers
                   9341: 
                   9342: =over 4
                   9343: 
1.648     raeburn  9344: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9345: 
1.258     albertel 9346: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9347: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9348: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9349: 
                   9350: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9351: $possible_names is an ref to an array of form element names.  As an example:
                   9352: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9353: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9354: 
                   9355: =cut
1.1       albertel 9356: 
1.6       albertel 9357: sub get_unprocessed_cgi {
1.25      albertel 9358:   my ($query,$possible_names)= @_;
1.26      matthew  9359:   # $Apache::lonxml::debug=1;
1.356     albertel 9360:   foreach my $pair (split(/&/,$query)) {
                   9361:     my ($name, $value) = split(/=/,$pair);
1.369     www      9362:     $name = &unescape($name);
1.25      albertel 9363:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9364:       $value =~ tr/+/ /;
                   9365:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9366:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9367:     }
1.16      harris41 9368:   }
1.6       albertel 9369: }
                   9370: 
1.112     bowersj2 9371: =pod
                   9372: 
1.648     raeburn  9373: =item * &cacheheader() 
1.112     bowersj2 9374: 
                   9375: returns cache-controlling header code
                   9376: 
                   9377: =cut
                   9378: 
1.7       albertel 9379: sub cacheheader {
1.258     albertel 9380:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9381:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9382:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9383:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9384:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9385:     return $output;
1.7       albertel 9386: }
                   9387: 
1.112     bowersj2 9388: =pod
                   9389: 
1.648     raeburn  9390: =item * &no_cache($r) 
1.112     bowersj2 9391: 
                   9392: specifies header code to not have cache
                   9393: 
                   9394: =cut
                   9395: 
1.9       albertel 9396: sub no_cache {
1.216     albertel 9397:     my ($r) = @_;
                   9398:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9399: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9400:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9401:     $r->no_cache(1);
                   9402:     $r->header_out("Expires" => $date);
                   9403:     $r->header_out("Pragma" => "no-cache");
1.123     www      9404: }
                   9405: 
                   9406: sub content_type {
1.181     albertel 9407:     my ($r,$type,$charset) = @_;
1.299     foxr     9408:     if ($r) {
                   9409: 	#  Note that printout.pl calls this with undef for $r.
                   9410: 	&no_cache($r);
                   9411:     }
1.258     albertel 9412:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9413:     unless ($charset) {
                   9414: 	$charset=&Apache::lonlocal::current_encoding;
                   9415:     }
                   9416:     if ($charset) { $type.='; charset='.$charset; }
                   9417:     if ($r) {
                   9418: 	$r->content_type($type);
                   9419:     } else {
                   9420: 	print("Content-type: $type\n\n");
                   9421:     }
1.9       albertel 9422: }
1.25      albertel 9423: 
1.112     bowersj2 9424: =pod
                   9425: 
1.648     raeburn  9426: =item * &add_to_env($name,$value) 
1.112     bowersj2 9427: 
1.258     albertel 9428: adds $name to the %env hash with value
1.112     bowersj2 9429: $value, if $name already exists, the entry is converted to an array
                   9430: reference and $value is added to the array.
                   9431: 
                   9432: =cut
                   9433: 
1.25      albertel 9434: sub add_to_env {
                   9435:   my ($name,$value)=@_;
1.258     albertel 9436:   if (defined($env{$name})) {
                   9437:     if (ref($env{$name})) {
1.25      albertel 9438:       #already have multiple values
1.258     albertel 9439:       push(@{ $env{$name} },$value);
1.25      albertel 9440:     } else {
                   9441:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9442:       my $first=$env{$name};
                   9443:       undef($env{$name});
                   9444:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9445:     }
                   9446:   } else {
1.258     albertel 9447:     $env{$name}=$value;
1.25      albertel 9448:   }
1.31      albertel 9449: }
1.149     albertel 9450: 
                   9451: =pod
                   9452: 
1.648     raeburn  9453: =item * &get_env_multiple($name) 
1.149     albertel 9454: 
1.258     albertel 9455: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9456: values may be defined and end up as an array ref.
                   9457: 
                   9458: returns an array of values
                   9459: 
                   9460: =cut
                   9461: 
                   9462: sub get_env_multiple {
                   9463:     my ($name) = @_;
                   9464:     my @values;
1.258     albertel 9465:     if (defined($env{$name})) {
1.149     albertel 9466:         # exists is it an array
1.258     albertel 9467:         if (ref($env{$name})) {
                   9468:             @values=@{ $env{$name} };
1.149     albertel 9469:         } else {
1.258     albertel 9470:             $values[0]=$env{$name};
1.149     albertel 9471:         }
                   9472:     }
                   9473:     return(@values);
                   9474: }
                   9475: 
1.660     raeburn  9476: sub ask_for_embedded_content {
                   9477:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9478:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9479:         %currsubfile,%unused,$rem);
1.1071    raeburn  9480:     my $counter = 0;
                   9481:     my $numnew = 0;
1.987     raeburn  9482:     my $numremref = 0;
                   9483:     my $numinvalid = 0;
                   9484:     my $numpathchg = 0;
                   9485:     my $numexisting = 0;
1.1071    raeburn  9486:     my $numunused = 0;
                   9487:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9488:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9489:     my $heading = &mt('Upload embedded files');
                   9490:     my $buttontext = &mt('Upload');
                   9491: 
1.1075.2.11  raeburn  9492:     my $navmap;
                   9493:     if ($env{'request.course.id'}) {
                   9494:         $navmap = Apache::lonnavmaps::navmap->new();
                   9495:     }
1.984     raeburn  9496:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9497:         my $current_path='/';
                   9498:         if ($env{'form.currentpath'}) {
                   9499:             $current_path = $env{'form.currentpath'};
                   9500:         }
                   9501:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   9502:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9503:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9504:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9505:         } else {
                   9506:             $udom = $env{'user.domain'};
                   9507:             $uname = $env{'user.name'};
                   9508:             $url = '/userfiles/portfolio';
                   9509:         }
1.987     raeburn  9510:         $toplevel = $url.'/';
1.984     raeburn  9511:         $url .= $current_path;
                   9512:         $getpropath = 1;
1.987     raeburn  9513:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9514:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9515:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9516:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9517:         $toplevel = $url;
1.984     raeburn  9518:         if ($rest ne '') {
1.987     raeburn  9519:             $url .= $rest;
                   9520:         }
                   9521:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9522:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9523:             $url = $args->{'docs_url'};
                   9524:             $toplevel = $url;
1.1075.2.11  raeburn  9525:             if ($args->{'context'} eq 'paste') {
                   9526:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9527:                 ($path) =
                   9528:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9529:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9530:                 $fileloc =~ s{^/}{};
                   9531:             }
1.1071    raeburn  9532:         }
                   9533:     } elsif ($actionurl eq '/adm/dependencies') {
                   9534:         if ($env{'request.course.id'} ne '') {
                   9535:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9536:             $cnum =  $env{'course.'.$env{'request.course.id'}.'.num'};
                   9537:             if (ref($args) eq 'HASH') {
                   9538:                 $url = $args->{'docs_url'};
                   9539:                 $title = $args->{'docs_title'};
                   9540:                 $toplevel = "/$url";
1.1075.2.11  raeburn  9541:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071    raeburn  9542:                 ($path) =  
                   9543:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9544:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9545:                 $fileloc =~ s{^/}{};
                   9546:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9547:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9548:             }
1.987     raeburn  9549:         }
                   9550:     }
                   9551:     my $now = time();
                   9552:     foreach my $embed_file (keys(%{$allfiles})) {
                   9553:         my $absolutepath;
                   9554:         if ($embed_file =~ m{^\w+://}) {
                   9555:             $newfiles{$embed_file} = 1;
                   9556:             $mapping{$embed_file} = $embed_file;
                   9557:         } else {
                   9558:             if ($embed_file =~ m{^/}) {
                   9559:                 $absolutepath = $embed_file;
                   9560:                 $embed_file =~ s{^(/+)}{};
                   9561:             }
                   9562:             if ($embed_file =~ m{/}) {
                   9563:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   9564:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9565:                 my $item = $fname;
                   9566:                 if ($path ne '') {
                   9567:                     $item = $path.'/'.$fname;
                   9568:                     $subdependencies{$path}{$fname} = 1;
                   9569:                 } else {
                   9570:                     $dependencies{$item} = 1;
                   9571:                 }
                   9572:                 if ($absolutepath) {
                   9573:                     $mapping{$item} = $absolutepath;
                   9574:                 } else {
                   9575:                     $mapping{$item} = $embed_file;
                   9576:                 }
                   9577:             } else {
                   9578:                 $dependencies{$embed_file} = 1;
                   9579:                 if ($absolutepath) {
                   9580:                     $mapping{$embed_file} = $absolutepath;
                   9581:                 } else {
                   9582:                     $mapping{$embed_file} = $embed_file;
                   9583:                 }
                   9584:             }
1.984     raeburn  9585:         }
                   9586:     }
1.1071    raeburn  9587:     my $dirptr = 16384;
1.984     raeburn  9588:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9589:         $currsubfile{$path} = {};
1.984     raeburn  9590:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9591:             my ($sublistref,$listerror) =
                   9592:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9593:             if (ref($sublistref) eq 'ARRAY') {
                   9594:                 foreach my $line (@{$sublistref}) {
                   9595:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9596:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  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.'/'.$path)) {
                   9601:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9602:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9603:             }
1.1075.2.11  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 ($sublistref,$listerror) =
                   9611:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9612:                     if (ref($sublistref) eq 'ARRAY') {
                   9613:                         foreach my $line (@{$sublistref}) {
                   9614:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9615:                                 undef,$mtime)=split(/\&/,$line,12);
                   9616:                             unless (($testdir&$dirptr) ||
                   9617:                                     ($file_name =~ /^\.\.?$/)) {
                   9618:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9619:                             }
                   9620:                         }
                   9621:                     }
                   9622:                 }
1.984     raeburn  9623:             }
                   9624:         }
                   9625:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9626:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9627:                 my $item = $path.'/'.$file;
                   9628:                 unless ($mapping{$item} eq $item) {
                   9629:                     $pathchanges{$item} = 1;
                   9630:                 }
                   9631:                 $existing{$item} = 1;
                   9632:                 $numexisting ++;
                   9633:             } else {
                   9634:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9635:             }
                   9636:         }
1.1071    raeburn  9637:         if ($actionurl eq '/adm/dependencies') {
                   9638:             foreach my $path (keys(%currsubfile)) {
                   9639:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9640:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9641:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  9642:                              next if (($rem ne '') &&
                   9643:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9644:                                        (ref($navmap) &&
                   9645:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9646:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9647:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9648:                              $unused{$path.'/'.$file} = 1; 
                   9649:                          }
                   9650:                     }
                   9651:                 }
                   9652:             }
                   9653:         }
1.984     raeburn  9654:     }
1.987     raeburn  9655:     my %currfile;
1.984     raeburn  9656:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9657:         my ($dirlistref,$listerror) =
                   9658:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9659:         if (ref($dirlistref) eq 'ARRAY') {
                   9660:             foreach my $line (@{$dirlistref}) {
                   9661:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9662:                 $currfile{$file_name} = 1;
                   9663:             }
1.984     raeburn  9664:         }
1.987     raeburn  9665:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9666:         if (opendir(my $dir,$url)) {
1.987     raeburn  9667:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9668:             map {$currfile{$_} = 1;} @dir_list;
                   9669:         }
1.1075.2.11  raeburn  9670:     } elsif (($actionurl eq '/adm/dependencies') ||
                   9671:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9672:               ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9673:         if ($env{'request.course.id'} ne '') {
                   9674:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9675:             if ($dir ne '') {
                   9676:                 my ($dirlistref,$listerror) =
                   9677:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9678:                 if (ref($dirlistref) eq 'ARRAY') {
                   9679:                     foreach my $line (@{$dirlistref}) {
                   9680:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   9681:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   9682:                         unless (($testdir&$dirptr) ||
                   9683:                                 ($file_name =~ /^\.\.?$/)) {
                   9684:                             $currfile{$file_name} = [$size,$mtime];
                   9685:                         }
                   9686:                     }
                   9687:                 }
                   9688:             }
                   9689:         }
1.984     raeburn  9690:     }
                   9691:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  9692:         if (exists($currfile{$file})) {
1.987     raeburn  9693:             unless ($mapping{$file} eq $file) {
                   9694:                 $pathchanges{$file} = 1;
                   9695:             }
                   9696:             $existing{$file} = 1;
                   9697:             $numexisting ++;
                   9698:         } else {
1.984     raeburn  9699:             $newfiles{$file} = 1;
                   9700:         }
                   9701:     }
1.1071    raeburn  9702:     foreach my $file (keys(%currfile)) {
                   9703:         unless (($file eq $filename) ||
                   9704:                 ($file eq $filename.'.bak') ||
                   9705:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  9706:             if ($actionurl eq '/adm/dependencies') {
                   9707:                 next if (($rem ne '') &&
                   9708:                          (($env{"httpref.$rem".$file} ne '') ||
                   9709:                           (ref($navmap) &&
                   9710:                           (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   9711:                            (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9712:                             ($navmap->getResourceByUrl($rem.$1)))))));
                   9713:             }
1.1071    raeburn  9714:             $unused{$file} = 1;
                   9715:         }
                   9716:     }
1.1075.2.11  raeburn  9717:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9718:         ($args->{'context'} eq 'paste')) {
                   9719:         $counter = scalar(keys(%existing));
                   9720:         $numpathchg = scalar(keys(%pathchanges));
                   9721:         return ($output,$counter,$numpathchg,\%existing);
                   9722:     }
1.984     raeburn  9723:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  9724:         if ($actionurl eq '/adm/dependencies') {
                   9725:             next if ($embed_file =~ m{^\w+://});
                   9726:         }
1.660     raeburn  9727:         $upload_output .= &start_data_table_row().
1.1071    raeburn  9728:                           '<td><img src="'.&icon($embed_file).'" />&nbsp;'.
                   9729:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  9730:         unless ($mapping{$embed_file} eq $embed_file) {
                   9731:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   9732:         }
                   9733:         $upload_output .= '</td><td>';
1.1071    raeburn  9734:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.660     raeburn  9735:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  9736:             $numremref++;
1.660     raeburn  9737:         } elsif ($args->{'error_on_invalid_names'}
                   9738:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987     raeburn  9739:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   9740:             $numinvalid++;
1.660     raeburn  9741:         } else {
1.1071    raeburn  9742:             $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  9743:                                                      $embed_file,\%mapping,
1.1071    raeburn  9744:                                                      $allfiles,$codebase,'upload');
                   9745:             $counter ++;
                   9746:             $numnew ++;
1.987     raeburn  9747:         }
                   9748:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   9749:     }
                   9750:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  9751:         if ($actionurl eq '/adm/dependencies') {
                   9752:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   9753:             $modify_output .= &start_data_table_row().
                   9754:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   9755:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   9756:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   9757:                               '<td>'.$size.'</td>'.
                   9758:                               '<td>'.$mtime.'</td>'.
                   9759:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   9760:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   9761:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   9762:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   9763:                               &embedded_file_element('upload_embedded',$counter,
                   9764:                                                      $embed_file,\%mapping,
                   9765:                                                      $allfiles,$codebase,'modify').
                   9766:                               '</div></td>'.
                   9767:                               &end_data_table_row()."\n";
                   9768:             $counter ++;
                   9769:         } else {
                   9770:             $upload_output .= &start_data_table_row().
                   9771:                               '<td><span class="LC_filename">'.$embed_file.'</span></td>';
                   9772:                               '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   9773:                               &Apache::loncommon::end_data_table_row()."\n";
                   9774:         }
                   9775:     }
                   9776:     my $delidx = $counter;
                   9777:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   9778:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   9779:         $delete_output .= &start_data_table_row().
                   9780:                           '<td><img src="'.&icon($oldfile).'" />'.
                   9781:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   9782:                           '<td>'.$size.'</td>'.
                   9783:                           '<td>'.$mtime.'</td>'.
                   9784:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   9785:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   9786:                           &embedded_file_element('upload_embedded',$delidx,
                   9787:                                                  $oldfile,\%mapping,$allfiles,
                   9788:                                                  $codebase,'delete').'</td>'.
                   9789:                           &end_data_table_row()."\n"; 
                   9790:         $numunused ++;
                   9791:         $delidx ++;
1.987     raeburn  9792:     }
                   9793:     if ($upload_output) {
                   9794:         $upload_output = &start_data_table().
                   9795:                          $upload_output.
                   9796:                          &end_data_table()."\n";
                   9797:     }
1.1071    raeburn  9798:     if ($modify_output) {
                   9799:         $modify_output = &start_data_table().
                   9800:                          &start_data_table_header_row().
                   9801:                          '<th>'.&mt('File').'</th>'.
                   9802:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9803:                          '<th>'.&mt('Modified').'</th>'.
                   9804:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   9805:                          &end_data_table_header_row().
                   9806:                          $modify_output.
                   9807:                          &end_data_table()."\n";
                   9808:     }
                   9809:     if ($delete_output) {
                   9810:         $delete_output = &start_data_table().
                   9811:                          &start_data_table_header_row().
                   9812:                          '<th>'.&mt('File').'</th>'.
                   9813:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9814:                          '<th>'.&mt('Modified').'</th>'.
                   9815:                          '<th>'.&mt('Delete?').'</th>'.
                   9816:                          &end_data_table_header_row().
                   9817:                          $delete_output.
                   9818:                          &end_data_table()."\n";
                   9819:     }
1.987     raeburn  9820:     my $applies = 0;
                   9821:     if ($numremref) {
                   9822:         $applies ++;
                   9823:     }
                   9824:     if ($numinvalid) {
                   9825:         $applies ++;
                   9826:     }
                   9827:     if ($numexisting) {
                   9828:         $applies ++;
                   9829:     }
1.1071    raeburn  9830:     if ($counter || $numunused) {
1.987     raeburn  9831:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   9832:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  9833:                   $state.'<h3>'.$heading.'</h3>'; 
                   9834:         if ($actionurl eq '/adm/dependencies') {
                   9835:             if ($numnew) {
                   9836:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   9837:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   9838:                            $upload_output.'<br />'."\n";
                   9839:             }
                   9840:             if ($numexisting) {
                   9841:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   9842:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   9843:                            $modify_output.'<br />'."\n";
                   9844:                            $buttontext = &mt('Save changes');
                   9845:             }
                   9846:             if ($numunused) {
                   9847:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   9848:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   9849:                            $delete_output.'<br />'."\n";
                   9850:                            $buttontext = &mt('Save changes');
                   9851:             }
                   9852:         } else {
                   9853:             $output .= $upload_output.'<br />'."\n";
                   9854:         }
                   9855:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   9856:                    $counter.'" />'."\n";
                   9857:         if ($actionurl eq '/adm/dependencies') { 
                   9858:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   9859:                        $numnew.'" />'."\n";
                   9860:         } elsif ($actionurl eq '') {
1.987     raeburn  9861:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   9862:         }
                   9863:     } elsif ($applies) {
                   9864:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   9865:         if ($applies > 1) {
                   9866:             $output .=  
                   9867:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   9868:             if ($numremref) {
                   9869:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   9870:             }
                   9871:             if ($numinvalid) {
                   9872:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   9873:             }
                   9874:             if ($numexisting) {
                   9875:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   9876:             }
                   9877:             $output .= '</ul><br />';
                   9878:         } elsif ($numremref) {
                   9879:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   9880:         } elsif ($numinvalid) {
                   9881:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   9882:         } elsif ($numexisting) {
                   9883:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   9884:         }
                   9885:         $output .= $upload_output.'<br />';
                   9886:     }
                   9887:     my ($pathchange_output,$chgcount);
1.1071    raeburn  9888:     $chgcount = $counter;
1.987     raeburn  9889:     if (keys(%pathchanges) > 0) {
                   9890:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  9891:             if ($counter) {
1.987     raeburn  9892:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   9893:                                                   $embed_file,\%mapping,
1.1071    raeburn  9894:                                                   $allfiles,$codebase,'change');
1.987     raeburn  9895:             } else {
                   9896:                 $pathchange_output .= 
                   9897:                     &start_data_table_row().
                   9898:                     '<td><input type ="checkbox" name="namechange" value="'.
                   9899:                     $chgcount.'" checked="checked" /></td>'.
                   9900:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   9901:                     '<td>'.$embed_file.
                   9902:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  9903:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  9904:                     '</td>'.&end_data_table_row();
1.660     raeburn  9905:             }
1.987     raeburn  9906:             $numpathchg ++;
                   9907:             $chgcount ++;
1.660     raeburn  9908:         }
                   9909:     }
1.1071    raeburn  9910:     if ($counter) {
1.987     raeburn  9911:         if ($numpathchg) {
                   9912:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9913:                        $numpathchg.'" />'."\n";
                   9914:         }
                   9915:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9916:             ($actionurl eq '/adm/imsimport')) {
                   9917:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9918:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9919:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  9920:         } elsif ($actionurl eq '/adm/dependencies') {
                   9921:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  9922:         }
1.1071    raeburn  9923:         $output .=  '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  9924:     } elsif ($numpathchg) {
                   9925:         my %pathchange = ();
                   9926:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9927:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9928:             $output .= '<p>'.&mt('or').'</p>'; 
                   9929:         } 
                   9930:     }
1.1071    raeburn  9931:     return ($output,$counter,$numpathchg);
1.987     raeburn  9932: }
                   9933: 
                   9934: sub embedded_file_element {
1.1071    raeburn  9935:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  9936:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9937:                    (ref($codebase) eq 'HASH'));
                   9938:     my $output;
1.1071    raeburn  9939:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  9940:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9941:     }
                   9942:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9943:                &escape($embed_file).'" />';
                   9944:     unless (($context eq 'upload_embedded') && 
                   9945:             ($mapping->{$embed_file} eq $embed_file)) {
                   9946:         $output .='
                   9947:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9948:     }
                   9949:     my $attrib;
                   9950:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9951:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9952:     }
                   9953:     $output .=
                   9954:         "\n\t\t".
                   9955:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9956:         $attrib.'" />';
                   9957:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9958:         $output .=
                   9959:             "\n\t\t".
                   9960:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9961:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9962:     }
1.987     raeburn  9963:     return $output;
1.660     raeburn  9964: }
                   9965: 
1.1071    raeburn  9966: sub get_dependency_details {
                   9967:     my ($currfile,$currsubfile,$embed_file) = @_;
                   9968:     my ($size,$mtime,$showsize,$showmtime);
                   9969:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   9970:         if ($embed_file =~ m{/}) {
                   9971:             my ($path,$fname) = split(/\//,$embed_file);
                   9972:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   9973:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   9974:             }
                   9975:         } else {
                   9976:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   9977:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   9978:             }
                   9979:         }
                   9980:         $showsize = $size/1024.0;
                   9981:         $showsize = sprintf("%.1f",$showsize);
                   9982:         if ($mtime > 0) {
                   9983:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   9984:         }
                   9985:     }
                   9986:     return ($showsize,$showmtime);
                   9987: }
                   9988: 
                   9989: sub ask_embedded_js {
                   9990:     return <<"END";
                   9991: <script type="text/javascript"">
                   9992: // <![CDATA[
                   9993: function toggleBrowse(counter) {
                   9994:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   9995:     var fileid = document.getElementById('embedded_item_'+counter);
                   9996:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   9997:     if (chkboxid.checked == true) {
                   9998:         uploaddivid.style.display='block';
                   9999:     } else {
                   10000:         uploaddivid.style.display='none';
                   10001:         fileid.value = '';
                   10002:     }
                   10003: }
                   10004: // ]]>
                   10005: </script>
                   10006: 
                   10007: END
                   10008: }
                   10009: 
1.661     raeburn  10010: sub upload_embedded {
                   10011:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10012:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10013:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10014:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10015:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10016:         my $orig_uploaded_filename =
                   10017:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10018:         foreach my $type ('orig','ref','attrib','codebase') {
                   10019:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10020:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10021:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10022:             }
                   10023:         }
1.661     raeburn  10024:         my ($path,$fname) =
                   10025:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10026:         # no path, whole string is fname
                   10027:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10028:         $fname = &Apache::lonnet::clean_filename($fname);
                   10029:         # See if there is anything left
                   10030:         next if ($fname eq '');
                   10031: 
                   10032:         # Check if file already exists as a file or directory.
                   10033:         my ($state,$msg);
                   10034:         if ($context eq 'portfolio') {
                   10035:             my $port_path = $dirpath;
                   10036:             if ($group ne '') {
                   10037:                 $port_path = "groups/$group/$port_path";
                   10038:             }
1.987     raeburn  10039:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10040:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10041:                                               $dir_root,$port_path,$disk_quota,
                   10042:                                               $current_disk_usage,$uname,$udom);
                   10043:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10044:                 || $state eq 'file_locked') {
1.661     raeburn  10045:                 $output .= $msg;
                   10046:                 next;
                   10047:             }
                   10048:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10049:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10050:             if ($state eq 'exists') {
                   10051:                 $output .= $msg;
                   10052:                 next;
                   10053:             }
                   10054:         }
                   10055:         # Check if extension is valid
                   10056:         if (($fname =~ /\.(\w+)$/) &&
                   10057:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  10058:             $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  10059:             next;
                   10060:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10061:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10062:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10063:             next;
                   10064:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  10065:             $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  10066:             next;
                   10067:         }
                   10068:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   10069:         if ($context eq 'portfolio') {
1.984     raeburn  10070:             my $result;
                   10071:             if ($state eq 'existingfile') {
                   10072:                 $result=
                   10073:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  10074:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  10075:             } else {
1.984     raeburn  10076:                 $result=
                   10077:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10078:                                                     $dirpath.
                   10079:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  10080:                 if ($result !~ m|^/uploaded/|) {
                   10081:                     $output .= '<span class="LC_error">'
                   10082:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10083:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10084:                                .'</span><br />';
                   10085:                     next;
                   10086:                 } else {
1.987     raeburn  10087:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10088:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10089:                 }
1.661     raeburn  10090:             }
1.987     raeburn  10091:         } elsif ($context eq 'coursedoc') {
                   10092:             my $result =
                   10093:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   10094:                                                 $dirpath.'/'.$path);
                   10095:             if ($result !~ m|^/uploaded/|) {
                   10096:                 $output .= '<span class="LC_error">'
                   10097:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10098:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10099:                            .'</span><br />';
                   10100:                     next;
                   10101:             } else {
                   10102:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10103:                            $path.$fname.'</span>').'<br />';
                   10104:             }
1.661     raeburn  10105:         } else {
                   10106: # Save the file
                   10107:             my $target = $env{'form.embedded_item_'.$i};
                   10108:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10109:             my $dest = $fullpath.$fname;
                   10110:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10111:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10112:             my $count;
                   10113:             my $filepath = $dir_root;
1.1027    raeburn  10114:             foreach my $subdir (@parts) {
                   10115:                 $filepath .= "/$subdir";
                   10116:                 if (!-e $filepath) {
1.661     raeburn  10117:                     mkdir($filepath,0770);
                   10118:                 }
                   10119:             }
                   10120:             my $fh;
                   10121:             if (!open($fh,'>'.$dest)) {
                   10122:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10123:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10124:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10125:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10126:                            '</span><br />';
                   10127:             } else {
                   10128:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10129:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10130:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10131:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10132:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10133:                               '</span><br />';
                   10134:                 } else {
1.987     raeburn  10135:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10136:                                $url.'</span>').'<br />';
                   10137:                     unless ($context eq 'testbank') {
                   10138:                         $footer .= &mt('View embedded file: [_1]',
                   10139:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10140:                     }
                   10141:                 }
                   10142:                 close($fh);
                   10143:             }
                   10144:         }
                   10145:         if ($env{'form.embedded_ref_'.$i}) {
                   10146:             $pathchange{$i} = 1;
                   10147:         }
                   10148:     }
                   10149:     if ($output) {
                   10150:         $output = '<p>'.$output.'</p>';
                   10151:     }
                   10152:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10153:     $returnflag = 'ok';
1.1071    raeburn  10154:     my $numpathchgs = scalar(keys(%pathchange));
                   10155:     if ($numpathchgs > 0) {
1.987     raeburn  10156:         if ($context eq 'portfolio') {
                   10157:             $output .= '<p>'.&mt('or').'</p>';
                   10158:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10159:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10160:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10161:             $returnflag = 'modify_orightml';
                   10162:         }
                   10163:     }
1.1071    raeburn  10164:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10165: }
                   10166: 
                   10167: sub modify_html_form {
                   10168:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10169:     my $end = 0;
                   10170:     my $modifyform;
                   10171:     if ($context eq 'upload_embedded') {
                   10172:         return unless (ref($pathchange) eq 'HASH');
                   10173:         if ($env{'form.number_embedded_items'}) {
                   10174:             $end += $env{'form.number_embedded_items'};
                   10175:         }
                   10176:         if ($env{'form.number_pathchange_items'}) {
                   10177:             $end += $env{'form.number_pathchange_items'};
                   10178:         }
                   10179:         if ($end) {
                   10180:             for (my $i=0; $i<$end; $i++) {
                   10181:                 if ($i < $env{'form.number_embedded_items'}) {
                   10182:                     next unless($pathchange->{$i});
                   10183:                 }
                   10184:                 $modifyform .=
                   10185:                     &start_data_table_row().
                   10186:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10187:                     'checked="checked" /></td>'.
                   10188:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10189:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10190:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10191:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10192:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10193:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10194:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10195:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10196:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10197:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10198:                     &end_data_table_row();
1.1071    raeburn  10199:             }
1.987     raeburn  10200:         }
                   10201:     } else {
                   10202:         $modifyform = $pathchgtable;
                   10203:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10204:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10205:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10206:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10207:         }
                   10208:     }
                   10209:     if ($modifyform) {
1.1071    raeburn  10210:         if ($actionurl eq '/adm/dependencies') {
                   10211:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10212:         }
1.987     raeburn  10213:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10214:                '<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".
                   10215:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10216:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10217:                '</ol></p>'."\n".'<p>'.
                   10218:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10219:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10220:                &start_data_table()."\n".
                   10221:                &start_data_table_header_row().
                   10222:                '<th>'.&mt('Change?').'</th>'.
                   10223:                '<th>'.&mt('Current reference').'</th>'.
                   10224:                '<th>'.&mt('Required reference').'</th>'.
                   10225:                &end_data_table_header_row()."\n".
                   10226:                $modifyform.
                   10227:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10228:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10229:                '</form>'."\n";
                   10230:     }
                   10231:     return;
                   10232: }
                   10233: 
                   10234: sub modify_html_refs {
                   10235:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   10236:     my $container;
                   10237:     if ($context eq 'portfolio') {
                   10238:         $container = $env{'form.container'};
                   10239:     } elsif ($context eq 'coursedoc') {
                   10240:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10241:     } elsif ($context eq 'manage_dependencies') {
                   10242:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10243:         $container = "/$container";
1.987     raeburn  10244:     } else {
1.1027    raeburn  10245:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10246:     }
                   10247:     my (%allfiles,%codebase,$output,$content);
                   10248:     my @changes = &get_env_multiple('form.namechange');
1.1071    raeburn  10249:     unless (@changes > 0) {
                   10250:         if (wantarray) {
                   10251:             return ('',0,0); 
                   10252:         } else {
                   10253:             return;
                   10254:         }
                   10255:     }
                   10256:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10257:         ($context eq 'manage_dependencies')) {
                   10258:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10259:             if (wantarray) {
                   10260:                 return ('',0,0);
                   10261:             } else {
                   10262:                 return;
                   10263:             }
                   10264:         } 
1.987     raeburn  10265:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10266:         if ($content eq '-1') {
                   10267:             if (wantarray) {
                   10268:                 return ('',0,0);
                   10269:             } else {
                   10270:                 return;
                   10271:             }
                   10272:         }
1.987     raeburn  10273:     } else {
1.1071    raeburn  10274:         unless ($container =~ /^\Q$dir_root\E/) {
                   10275:             if (wantarray) {
                   10276:                 return ('',0,0);
                   10277:             } else {
                   10278:                 return;
                   10279:             }
                   10280:         } 
1.987     raeburn  10281:         if (open(my $fh,"<$container")) {
                   10282:             $content = join('', <$fh>);
                   10283:             close($fh);
                   10284:         } else {
1.1071    raeburn  10285:             if (wantarray) {
                   10286:                 return ('',0,0);
                   10287:             } else {
                   10288:                 return;
                   10289:             }
1.987     raeburn  10290:         }
                   10291:     }
                   10292:     my ($count,$codebasecount) = (0,0);
                   10293:     my $mm = new File::MMagic;
                   10294:     my $mime_type = $mm->checktype_contents($content);
                   10295:     if ($mime_type eq 'text/html') {
                   10296:         my $parse_result = 
                   10297:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10298:                                                     \%codebase,\$content);
                   10299:         if ($parse_result eq 'ok') {
                   10300:             foreach my $i (@changes) {
                   10301:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10302:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10303:                 if ($allfiles{$ref}) {
                   10304:                     my $newname =  $orig;
                   10305:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10306:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10307:                     if ($attrib_regexp =~ /:/) {
                   10308:                         $attrib_regexp =~ s/\:/|/g;
                   10309:                     }
                   10310:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10311:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10312:                         $count += $numchg;
                   10313:                     }
                   10314:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10315:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10316:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10317:                         $codebasecount ++;
                   10318:                     }
                   10319:                 }
                   10320:             }
                   10321:             if ($count || $codebasecount) {
                   10322:                 my $saveresult;
1.1071    raeburn  10323:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10324:                     ($context eq 'manage_dependencies')) {
1.987     raeburn  10325:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10326:                     if ($url eq $container) {
                   10327:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10328:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10329:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10330:                                             $fname.'</span>').'</p>';
1.987     raeburn  10331:                     } else {
                   10332:                          $output = '<p class="LC_error">'.
                   10333:                                    &mt('Error: update failed for: [_1].',
                   10334:                                    '<span class="LC_filename">'.
                   10335:                                    $container.'</span>').'</p>';
                   10336:                     }
                   10337:                 } else {
                   10338:                     if (open(my $fh,">$container")) {
                   10339:                         print $fh $content;
                   10340:                         close($fh);
                   10341:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10342:                                   $count,'<span class="LC_filename">'.
                   10343:                                   $container.'</span>').'</p>';
1.661     raeburn  10344:                     } else {
1.987     raeburn  10345:                          $output = '<p class="LC_error">'.
                   10346:                                    &mt('Error: could not update [_1].',
                   10347:                                    '<span class="LC_filename">'.
                   10348:                                    $container.'</span>').'</p>';
1.661     raeburn  10349:                     }
                   10350:                 }
                   10351:             }
1.987     raeburn  10352:         } else {
                   10353:             &logthis('Failed to parse '.$container.
                   10354:                      ' to modify references: '.$parse_result);
1.661     raeburn  10355:         }
                   10356:     }
1.1071    raeburn  10357:     if (wantarray) {
                   10358:         return ($output,$count,$codebasecount);
                   10359:     } else {
                   10360:         return $output;
                   10361:     }
1.661     raeburn  10362: }
                   10363: 
                   10364: sub check_for_existing {
                   10365:     my ($path,$fname,$element) = @_;
                   10366:     my ($state,$msg);
                   10367:     if (-d $path.'/'.$fname) {
                   10368:         $state = 'exists';
                   10369:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10370:     } elsif (-e $path.'/'.$fname) {
                   10371:         $state = 'exists';
                   10372:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10373:     }
                   10374:     if ($state eq 'exists') {
                   10375:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10376:     }
                   10377:     return ($state,$msg);
                   10378: }
                   10379: 
                   10380: sub check_for_upload {
                   10381:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10382:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10383:     my $filesize = length($env{'form.'.$element});
                   10384:     if (!$filesize) {
                   10385:         my $msg = '<span class="LC_error">'.
                   10386:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10387:                       '<span class="LC_filename">'.$fname.'</span>',
                   10388:                       $filesize).'<br />'.
1.1007    raeburn  10389:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10390:                   '</span>';
                   10391:         return ('zero_bytes',$msg);
                   10392:     }
                   10393:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10394:     my $getpropath = 1;
1.1021    raeburn  10395:     my ($dirlistref,$listerror) =
                   10396:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10397:     my $found_file = 0;
                   10398:     my $locked_file = 0;
1.991     raeburn  10399:     my @lockers;
                   10400:     my $navmap;
                   10401:     if ($env{'request.course.id'}) {
                   10402:         $navmap = Apache::lonnavmaps::navmap->new();
                   10403:     }
1.1021    raeburn  10404:     if (ref($dirlistref) eq 'ARRAY') {
                   10405:         foreach my $line (@{$dirlistref}) {
                   10406:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10407:             if ($file_name eq $fname){
                   10408:                 $file_name = $path.$file_name;
                   10409:                 if ($group ne '') {
                   10410:                     $file_name = $group.$file_name;
                   10411:                 }
                   10412:                 $found_file = 1;
                   10413:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10414:                     foreach my $lock (@lockers) {
                   10415:                         if (ref($lock) eq 'ARRAY') {
                   10416:                             my ($symb,$crsid) = @{$lock};
                   10417:                             if ($crsid eq $env{'request.course.id'}) {
                   10418:                                 if (ref($navmap)) {
                   10419:                                     my $res = $navmap->getBySymb($symb);
                   10420:                                     foreach my $part (@{$res->parts()}) { 
                   10421:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10422:                                         unless (($slot_status == $res->RESERVED) ||
                   10423:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10424:                                             $locked_file = 1;
                   10425:                                         }
1.991     raeburn  10426:                                     }
1.1021    raeburn  10427:                                 } else {
                   10428:                                     $locked_file = 1;
1.991     raeburn  10429:                                 }
                   10430:                             } else {
                   10431:                                 $locked_file = 1;
                   10432:                             }
                   10433:                         }
1.1021    raeburn  10434:                    }
                   10435:                 } else {
                   10436:                     my @info = split(/\&/,$rest);
                   10437:                     my $currsize = $info[6]/1000;
                   10438:                     if ($currsize < $filesize) {
                   10439:                         my $extra = $filesize - $currsize;
                   10440:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10441:                             my $msg = '<span class="LC_error">'.
                   10442:                                       &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.',
                   10443:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10444:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10445:                                                    $disk_quota,$current_disk_usage);
                   10446:                             return ('will_exceed_quota',$msg);
                   10447:                         }
1.984     raeburn  10448:                     }
                   10449:                 }
1.661     raeburn  10450:             }
                   10451:         }
                   10452:     }
                   10453:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10454:         my $msg = '<span class="LC_error">'.
                   10455:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10456:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10457:         return ('will_exceed_quota',$msg);
                   10458:     } elsif ($found_file) {
                   10459:         if ($locked_file) {
                   10460:             my $msg = '<span class="LC_error">';
                   10461:             $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>');
                   10462:             $msg .= '</span><br />';
                   10463:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10464:             return ('file_locked',$msg);
                   10465:         } else {
                   10466:             my $msg = '<span class="LC_error">';
1.984     raeburn  10467:             $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  10468:             $msg .= '</span>';
1.984     raeburn  10469:             return ('existingfile',$msg);
1.661     raeburn  10470:         }
                   10471:     }
                   10472: }
                   10473: 
1.987     raeburn  10474: sub check_for_traversal {
                   10475:     my ($path,$url,$toplevel) = @_;
                   10476:     my @parts=split(/\//,$path);
                   10477:     my $cleanpath;
                   10478:     my $fullpath = $url;
                   10479:     for (my $i=0;$i<@parts;$i++) {
                   10480:         next if ($parts[$i] eq '.');
                   10481:         if ($parts[$i] eq '..') {
                   10482:             $fullpath =~ s{([^/]+/)$}{};
                   10483:         } else {
                   10484:             $fullpath .= $parts[$i].'/';
                   10485:         }
                   10486:     }
                   10487:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10488:         $cleanpath = $1;
                   10489:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10490:         my $curr_toprel = $1;
                   10491:         my @parts = split(/\//,$curr_toprel);
                   10492:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10493:         my @urlparts = split(/\//,$url_toprel);
                   10494:         my $doubledots;
                   10495:         my $startdiff = -1;
                   10496:         for (my $i=0; $i<@urlparts; $i++) {
                   10497:             if ($startdiff == -1) {
                   10498:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10499:                     $startdiff = $i;
                   10500:                     $doubledots .= '../';
                   10501:                 }
                   10502:             } else {
                   10503:                 $doubledots .= '../';
                   10504:             }
                   10505:         }
                   10506:         if ($startdiff > -1) {
                   10507:             $cleanpath = $doubledots;
                   10508:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10509:                 $cleanpath .= $parts[$i].'/';
                   10510:             }
                   10511:         }
                   10512:     }
                   10513:     $cleanpath =~ s{(/)$}{};
                   10514:     return $cleanpath;
                   10515: }
1.31      albertel 10516: 
1.1053    raeburn  10517: sub is_archive_file {
                   10518:     my ($mimetype) = @_;
                   10519:     if (($mimetype eq 'application/octet-stream') ||
                   10520:         ($mimetype eq 'application/x-stuffit') ||
                   10521:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10522:         return 1;
                   10523:     }
                   10524:     return;
                   10525: }
                   10526: 
                   10527: sub decompress_form {
1.1065    raeburn  10528:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10529:     my %lt = &Apache::lonlocal::texthash (
                   10530:         this => 'This file is an archive file.',
1.1067    raeburn  10531:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10532:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10533:         youm => 'You may wish to extract its contents.',
                   10534:         extr => 'Extract contents',
1.1067    raeburn  10535:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10536:         proa => 'Process automatically?',
1.1053    raeburn  10537:         yes  => 'Yes',
                   10538:         no   => 'No',
1.1067    raeburn  10539:         fold => 'Title for folder containing movie',
                   10540:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10541:     );
1.1065    raeburn  10542:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10543:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10544:     my $info = &list_archive_contents($fileloc,\@paths);
                   10545:     if (@paths) {
                   10546:         foreach my $path (@paths) {
                   10547:             $path =~ s{^/}{};
1.1067    raeburn  10548:             if ($path =~ m{^([^/]+)/$}) {
                   10549:                 $topdir = $1;
                   10550:             }
1.1065    raeburn  10551:             if ($path =~ m{^([^/]+)/}) {
                   10552:                 $toplevel{$1} = $path;
                   10553:             } else {
                   10554:                 $toplevel{$path} = $path;
                   10555:             }
                   10556:         }
                   10557:     }
1.1067    raeburn  10558:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10559:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10560:                         "$topdir/media/",
                   10561:                         "$topdir/media/$topdir.mp4",
                   10562:                         "$topdir/media/FirstFrame.png",
                   10563:                         "$topdir/media/player.swf",
                   10564:                         "$topdir/media/swfobject.js",
                   10565:                         "$topdir/media/expressInstall.swf");
                   10566:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10567:         if (@diffs == 0) {
                   10568:             $is_camtasia = 1;
                   10569:         }
                   10570:     }
                   10571:     my $output;
                   10572:     if ($is_camtasia) {
                   10573:         $output = <<"ENDCAM";
                   10574: <script type="text/javascript" language="Javascript">
                   10575: // <![CDATA[
                   10576: 
                   10577: function camtasiaToggle() {
                   10578:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10579:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10580:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10581: 
                   10582:                 document.getElementById('camtasia_titles').style.display='block';
                   10583:             } else {
                   10584:                 document.getElementById('camtasia_titles').style.display='none';
                   10585:             }
                   10586:         }
                   10587:     }
                   10588:     return;
                   10589: }
                   10590: 
                   10591: // ]]>
                   10592: </script>
                   10593: <p>$lt{'camt'}</p>
                   10594: ENDCAM
1.1065    raeburn  10595:     } else {
1.1067    raeburn  10596:         $output = '<p>'.$lt{'this'};
                   10597:         if ($info eq '') {
                   10598:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   10599:         } else {
                   10600:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   10601:                        '<div><pre>'.$info.'</pre></div>';
                   10602:         }
1.1065    raeburn  10603:     }
1.1067    raeburn  10604:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  10605:     my $duplicates;
                   10606:     my $num = 0;
                   10607:     if (ref($dirlist) eq 'ARRAY') {
                   10608:         foreach my $item (@{$dirlist}) {
                   10609:             if (ref($item) eq 'ARRAY') {
                   10610:                 if (exists($toplevel{$item->[0]})) {
                   10611:                     $duplicates .= 
                   10612:                         &start_data_table_row().
                   10613:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10614:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   10615:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10616:                         'value="1" />'.&mt('Yes').'</label>'.
                   10617:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   10618:                         '<td>'.$item->[0].'</td>';
                   10619:                     if ($item->[2]) {
                   10620:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   10621:                     } else {
                   10622:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   10623:                     }
                   10624:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   10625:                                    '<td>'.
                   10626:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   10627:                                    '</td>'.
                   10628:                                    &end_data_table_row();
                   10629:                     $num ++;
                   10630:                 }
                   10631:             }
                   10632:         }
                   10633:     }
                   10634:     my $itemcount;
                   10635:     if (@paths > 0) {
                   10636:         $itemcount = scalar(@paths);
                   10637:     } else {
                   10638:         $itemcount = 1;
                   10639:     }
1.1067    raeburn  10640:     if ($is_camtasia) {
                   10641:         $output .= $lt{'auto'}.'<br />'.
                   10642:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   10643:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   10644:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   10645:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   10646:                    $lt{'no'}.'</label></span><br />'.
                   10647:                    '<div id="camtasia_titles" style="display:block">'.
                   10648:                    &Apache::lonhtmlcommon::start_pick_box().
                   10649:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   10650:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   10651:                    &Apache::lonhtmlcommon::row_closure().
                   10652:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   10653:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   10654:                    &Apache::lonhtmlcommon::row_closure(1).
                   10655:                    &Apache::lonhtmlcommon::end_pick_box().
                   10656:                    '</div>';
                   10657:     }
1.1065    raeburn  10658:     $output .= 
                   10659:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  10660:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   10661:         "\n";
1.1065    raeburn  10662:     if ($duplicates ne '') {
                   10663:         $output .= '<p><span class="LC_warning">'.
                   10664:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   10665:                    &start_data_table().
                   10666:                    &start_data_table_header_row().
                   10667:                    '<th>'.&mt('Overwrite?').'</th>'.
                   10668:                    '<th>'.&mt('Name').'</th>'.
                   10669:                    '<th>'.&mt('Type').'</th>'.
                   10670:                    '<th>'.&mt('Size').'</th>'.
                   10671:                    '<th>'.&mt('Last modified').'</th>'.
                   10672:                    &end_data_table_header_row().
                   10673:                    $duplicates.
                   10674:                    &end_data_table().
                   10675:                    '</p>';
                   10676:     }
1.1067    raeburn  10677:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  10678:     if (ref($hiddenelements) eq 'HASH') {
                   10679:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   10680:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   10681:         }
                   10682:     }
                   10683:     $output .= <<"END";
1.1067    raeburn  10684: <br />
1.1053    raeburn  10685: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   10686: </form>
                   10687: $noextract
                   10688: END
                   10689:     return $output;
                   10690: }
                   10691: 
1.1065    raeburn  10692: sub decompression_utility {
                   10693:     my ($program) = @_;
                   10694:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   10695:     my $location;
                   10696:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   10697:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   10698:                          '/usr/sbin/') {
                   10699:             if (-x $dir.$program) {
                   10700:                 $location = $dir.$program;
                   10701:                 last;
                   10702:             }
                   10703:         }
                   10704:     }
                   10705:     return $location;
                   10706: }
                   10707: 
                   10708: sub list_archive_contents {
                   10709:     my ($file,$pathsref) = @_;
                   10710:     my (@cmd,$output);
                   10711:     my $needsregexp;
                   10712:     if ($file =~ /\.zip$/) {
                   10713:         @cmd = (&decompression_utility('unzip'),"-l");
                   10714:         $needsregexp = 1;
                   10715:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   10716:              ($file =~ /\.tgz$/)) {
                   10717:         @cmd = (&decompression_utility('tar'),"-ztf");
                   10718:     } elsif ($file =~ /\.tar\.bz2$/) {
                   10719:         @cmd = (&decompression_utility('tar'),"-jtf");
                   10720:     } elsif ($file =~ m|\.tar$|) {
                   10721:         @cmd = (&decompression_utility('tar'),"-tf");
                   10722:     }
                   10723:     if (@cmd) {
                   10724:         undef($!);
                   10725:         undef($@);
                   10726:         if (open(my $fh,"-|", @cmd, $file)) {
                   10727:             while (my $line = <$fh>) {
                   10728:                 $output .= $line;
                   10729:                 chomp($line);
                   10730:                 my $item;
                   10731:                 if ($needsregexp) {
                   10732:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   10733:                 } else {
                   10734:                     $item = $line;
                   10735:                 }
                   10736:                 if ($item ne '') {
                   10737:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   10738:                         push(@{$pathsref},$item);
                   10739:                     } 
                   10740:                 }
                   10741:             }
                   10742:             close($fh);
                   10743:         }
                   10744:     }
                   10745:     return $output;
                   10746: }
                   10747: 
1.1053    raeburn  10748: sub decompress_uploaded_file {
                   10749:     my ($file,$dir) = @_;
                   10750:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   10751:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   10752:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   10753:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   10754:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   10755:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   10756:     my $decompressed = $env{'cgi.decompressed'};
                   10757:     &Apache::lonnet::delenv('cgi.file');
                   10758:     &Apache::lonnet::delenv('cgi.dir');
                   10759:     &Apache::lonnet::delenv('cgi.decompressed');
                   10760:     return ($decompressed,$result);
                   10761: }
                   10762: 
1.1055    raeburn  10763: sub process_decompression {
                   10764:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   10765:     my ($dir,$error,$warning,$output);
                   10766:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
                   10767:         $error = &mt('File name not a supported archive file type.').
                   10768:                  '<br />'.&mt('File name should end with one of: [_1].',
                   10769:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   10770:     } else {
                   10771:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   10772:         if ($docuhome eq 'no_host') {
                   10773:             $error = &mt('Could not determine home server for course.');
                   10774:         } else {
                   10775:             my @ids=&Apache::lonnet::current_machine_ids();
                   10776:             my $currdir = "$dir_root/$destination";
                   10777:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   10778:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   10779:                        "$dir_root/$destination";
                   10780:             } else {
                   10781:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   10782:                        "$dir_root/$docudom/$docuname/$destination";
                   10783:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   10784:                     $error = &mt('Archive file not found.');
                   10785:                 }
                   10786:             }
1.1065    raeburn  10787:             my (@to_overwrite,@to_skip);
                   10788:             if ($env{'form.archive_overwrite_total'} > 0) {
                   10789:                 my $total = $env{'form.archive_overwrite_total'};
                   10790:                 for (my $i=0; $i<$total; $i++) {
                   10791:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   10792:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   10793:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   10794:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   10795:                     }
                   10796:                 }
                   10797:             }
                   10798:             my $numskip = scalar(@to_skip);
                   10799:             if (($numskip > 0) && 
                   10800:                 ($numskip == $env{'form.archive_itemcount'})) {
                   10801:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   10802:             } elsif ($dir eq '') {
1.1055    raeburn  10803:                 $error = &mt('Directory containing archive file unavailable.');
                   10804:             } elsif (!$error) {
1.1065    raeburn  10805:                 my ($decompressed,$display);
                   10806:                 if ($numskip > 0) {
                   10807:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   10808:                     mkdir("$dir/$tempdir",0755);
                   10809:                     system("mv $dir/$file $dir/$tempdir/$file");
                   10810:                     ($decompressed,$display) = 
                   10811:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   10812:                     foreach my $item (@to_skip) {
                   10813:                         if (($item ne '') && ($item !~ /\.\./)) {
                   10814:                             if (-f "$dir/$tempdir/$item") { 
                   10815:                                 unlink("$dir/$tempdir/$item");
                   10816:                             } elsif (-d "$dir/$tempdir/$item") {
                   10817:                                 system("rm -rf $dir/$tempdir/$item");
                   10818:                             }
                   10819:                         }
                   10820:                     }
                   10821:                     system("mv $dir/$tempdir/* $dir");
                   10822:                     rmdir("$dir/$tempdir");   
                   10823:                 } else {
                   10824:                     ($decompressed,$display) = 
                   10825:                         &decompress_uploaded_file($file,$dir);
                   10826:                 }
1.1055    raeburn  10827:                 if ($decompressed eq 'ok') {
1.1065    raeburn  10828:                     $output = '<p class="LC_info">'.
                   10829:                               &mt('Files extracted successfully from archive.').
                   10830:                               '</p>'."\n";
1.1055    raeburn  10831:                     my ($warning,$result,@contents);
                   10832:                     my ($newdirlistref,$newlisterror) =
                   10833:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   10834:                                                  $docuname,1);
                   10835:                     my (%is_dir,%changes,@newitems);
                   10836:                     my $dirptr = 16384;
1.1065    raeburn  10837:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  10838:                         foreach my $dir_line (@{$newdirlistref}) {
                   10839:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  10840:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   10841:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  10842:                                 push(@newitems,$item);
                   10843:                                 if ($dirptr&$testdir) {
                   10844:                                     $is_dir{$item} = 1;
                   10845:                                 }
                   10846:                                 $changes{$item} = 1;
                   10847:                             }
                   10848:                         }
                   10849:                     }
                   10850:                     if (keys(%changes) > 0) {
                   10851:                         foreach my $item (sort(@newitems)) {
                   10852:                             if ($changes{$item}) {
                   10853:                                 push(@contents,$item);
                   10854:                             }
                   10855:                         }
                   10856:                     }
                   10857:                     if (@contents > 0) {
1.1067    raeburn  10858:                         my $wantform;
                   10859:                         unless ($env{'form.autoextract_camtasia'}) {
                   10860:                             $wantform = 1;
                   10861:                         }
1.1056    raeburn  10862:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  10863:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   10864:                                                                 $currdir,\%is_dir,
                   10865:                                                                 \%children,\%parent,
1.1056    raeburn  10866:                                                                 \@contents,\%dirorder,
                   10867:                                                                 \%titles,$wantform);
1.1055    raeburn  10868:                         if ($datatable ne '') {
                   10869:                             $output .= &archive_options_form('decompressed',$datatable,
                   10870:                                                              $count,$hiddenelem);
1.1065    raeburn  10871:                             my $startcount = 6;
1.1055    raeburn  10872:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  10873:                                                            \%titles,\%children);
1.1055    raeburn  10874:                         }
1.1067    raeburn  10875:                         if ($env{'form.autoextract_camtasia'}) {
                   10876:                             my %displayed;
                   10877:                             my $total = 1;
                   10878:                             $env{'form.archive_directory'} = [];
                   10879:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   10880:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   10881:                                 $path =~ s{/$}{};
                   10882:                                 my $item;
                   10883:                                 if ($path ne '') {
                   10884:                                     $item = "$path/$titles{$i}";
                   10885:                                 } else {
                   10886:                                     $item = $titles{$i};
                   10887:                                 }
                   10888:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   10889:                                 if ($item eq $contents[0]) {
                   10890:                                     push(@{$env{'form.archive_directory'}},$i);
                   10891:                                     $env{'form.archive_'.$i} = 'display';
                   10892:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   10893:                                     $displayed{'folder'} = $i;
                   10894:                                 } elsif ($item eq "$contents[0]/index.html") {
                   10895:                                     $env{'form.archive_'.$i} = 'display';
                   10896:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   10897:                                     $displayed{'web'} = $i;
                   10898:                                 } else {
                   10899:                                     if ($item eq "$contents[0]/media") {
                   10900:                                         push(@{$env{'form.archive_directory'}},$i);
                   10901:                                     }
                   10902:                                     $env{'form.archive_'.$i} = 'dependency';
                   10903:                                 }
                   10904:                                 $total ++;
                   10905:                             }
                   10906:                             for (my $i=1; $i<$total; $i++) {
                   10907:                                 next if ($i == $displayed{'web'});
                   10908:                                 next if ($i == $displayed{'folder'});
                   10909:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   10910:                             }
                   10911:                             $env{'form.phase'} = 'decompress_cleanup';
                   10912:                             $env{'form.archivedelete'} = 1;
                   10913:                             $env{'form.archive_count'} = $total-1;
                   10914:                             $output .=
                   10915:                                 &process_extracted_files('coursedocs',$docudom,
                   10916:                                                          $docuname,$destination,
                   10917:                                                          $dir_root,$hiddenelem);
                   10918:                         }
1.1055    raeburn  10919:                     } else {
                   10920:                         $warning = &mt('No new items extracted from archive file.');
                   10921:                     }
                   10922:                 } else {
                   10923:                     $output = $display;
                   10924:                     $error = &mt('An error occurred during extraction from the archive file.');
                   10925:                 }
                   10926:             }
                   10927:         }
                   10928:     }
                   10929:     if ($error) {
                   10930:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   10931:                    $error.'</p>'."\n";
                   10932:     }
                   10933:     if ($warning) {
                   10934:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   10935:     }
                   10936:     return $output;
                   10937: }
                   10938: 
                   10939: sub get_extracted {
1.1056    raeburn  10940:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   10941:         $titles,$wantform) = @_;
1.1055    raeburn  10942:     my $count = 0;
                   10943:     my $depth = 0;
                   10944:     my $datatable;
1.1056    raeburn  10945:     my @hierarchy;
1.1055    raeburn  10946:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  10947:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   10948:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  10949:     foreach my $item (@{$contents}) {
                   10950:         $count ++;
1.1056    raeburn  10951:         @{$dirorder->{$count}} = @hierarchy;
                   10952:         $titles->{$count} = $item;
1.1055    raeburn  10953:         &archive_hierarchy($depth,$count,$parent,$children);
                   10954:         if ($wantform) {
                   10955:             $datatable .= &archive_row($is_dir->{$item},$item,
                   10956:                                        $currdir,$depth,$count);
                   10957:         }
                   10958:         if ($is_dir->{$item}) {
                   10959:             $depth ++;
1.1056    raeburn  10960:             push(@hierarchy,$count);
                   10961:             $parent->{$depth} = $count;
1.1055    raeburn  10962:             $datatable .=
                   10963:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  10964:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   10965:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  10966:             $depth --;
1.1056    raeburn  10967:             pop(@hierarchy);
1.1055    raeburn  10968:         }
                   10969:     }
                   10970:     return ($count,$datatable);
                   10971: }
                   10972: 
                   10973: sub recurse_extracted_archive {
1.1056    raeburn  10974:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   10975:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  10976:     my $result='';
1.1056    raeburn  10977:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   10978:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   10979:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  10980:         return $result;
                   10981:     }
                   10982:     my $dirptr = 16384;
                   10983:     my ($newdirlistref,$newlisterror) =
                   10984:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   10985:     if (ref($newdirlistref) eq 'ARRAY') {
                   10986:         foreach my $dir_line (@{$newdirlistref}) {
                   10987:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   10988:             unless ($item =~ /^\.+$/) {
                   10989:                 $$count ++;
1.1056    raeburn  10990:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   10991:                 $titles->{$$count} = $item;
1.1055    raeburn  10992:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  10993: 
1.1055    raeburn  10994:                 my $is_dir;
                   10995:                 if ($dirptr&$testdir) {
                   10996:                     $is_dir = 1;
                   10997:                 }
                   10998:                 if ($wantform) {
                   10999:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11000:                 }
                   11001:                 if ($is_dir) {
                   11002:                     $$depth ++;
1.1056    raeburn  11003:                     push(@{$hierarchy},$$count);
                   11004:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11005:                     $result .=
                   11006:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11007:                                                    $docuname,$depth,$count,
1.1056    raeburn  11008:                                                    $hierarchy,$dirorder,$children,
                   11009:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11010:                     $$depth --;
1.1056    raeburn  11011:                     pop(@{$hierarchy});
1.1055    raeburn  11012:                 }
                   11013:             }
                   11014:         }
                   11015:     }
                   11016:     return $result;
                   11017: }
                   11018: 
                   11019: sub archive_hierarchy {
                   11020:     my ($depth,$count,$parent,$children) =@_;
                   11021:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11022:         if (exists($parent->{$depth})) {
                   11023:              $children->{$parent->{$depth}} .= $count.':';
                   11024:         }
                   11025:     }
                   11026:     return;
                   11027: }
                   11028: 
                   11029: sub archive_row {
                   11030:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11031:     my ($name) = ($item =~ m{([^/]+)$});
                   11032:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11033:                                        'display'    => 'Add as file',
1.1055    raeburn  11034:                                        'dependency' => 'Include as dependency',
                   11035:                                        'discard'    => 'Discard',
                   11036:                                       );
                   11037:     if ($is_dir) {
1.1059    raeburn  11038:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11039:     }
1.1056    raeburn  11040:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11041:     my $offset = 0;
1.1055    raeburn  11042:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11043:         $offset ++;
1.1065    raeburn  11044:         if ($action ne 'display') {
                   11045:             $offset ++;
                   11046:         }  
1.1055    raeburn  11047:         $output .= '<td><span class="LC_nobreak">'.
                   11048:                    '<label><input type="radio" name="archive_'.$count.
                   11049:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11050:         my $text = $choices{$action};
                   11051:         if ($is_dir) {
                   11052:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11053:             if ($action eq 'display') {
1.1059    raeburn  11054:                 $text = &mt('Add as folder');
1.1055    raeburn  11055:             }
1.1056    raeburn  11056:         } else {
                   11057:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11058: 
                   11059:         }
                   11060:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11061:         if ($action eq 'dependency') {
                   11062:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11063:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11064:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11065:                        '<option value=""></option>'."\n".
                   11066:                        '</select>'."\n".
                   11067:                        '</div>';
1.1059    raeburn  11068:         } elsif ($action eq 'display') {
                   11069:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11070:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11071:                        '</div>';
1.1055    raeburn  11072:         }
1.1056    raeburn  11073:         $output .= '</td>';
1.1055    raeburn  11074:     }
                   11075:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11076:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11077:     for (my $i=0; $i<$depth; $i++) {
                   11078:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11079:     }
                   11080:     if ($is_dir) {
                   11081:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11082:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11083:     } else {
                   11084:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11085:     }
                   11086:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11087:                &end_data_table_row();
                   11088:     return $output;
                   11089: }
                   11090: 
                   11091: sub archive_options_form {
1.1065    raeburn  11092:     my ($form,$display,$count,$hiddenelem) = @_;
                   11093:     my %lt = &Apache::lonlocal::texthash(
                   11094:                perm => 'Permanently remove archive file?',
                   11095:                hows => 'How should each extracted item be incorporated in the course?',
                   11096:                cont => 'Content actions for all',
                   11097:                addf => 'Add as folder/file',
                   11098:                incd => 'Include as dependency for a displayed file',
                   11099:                disc => 'Discard',
                   11100:                no   => 'No',
                   11101:                yes  => 'Yes',
                   11102:                save => 'Save',
                   11103:     );
                   11104:     my $output = <<"END";
                   11105: <form name="$form" method="post" action="">
                   11106: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11107: <label>
                   11108:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11109: </label>
                   11110: &nbsp;
                   11111: <label>
                   11112:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11113: </span>
                   11114: </p>
                   11115: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11116: <br />$lt{'hows'}
                   11117: <div class="LC_columnSection">
                   11118:   <fieldset>
                   11119:     <legend>$lt{'cont'}</legend>
                   11120:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11121:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11122:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11123:   </fieldset>
                   11124: </div>
                   11125: END
                   11126:     return $output.
1.1055    raeburn  11127:            &start_data_table()."\n".
1.1065    raeburn  11128:            $display."\n".
1.1055    raeburn  11129:            &end_data_table()."\n".
                   11130:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11131:            $hiddenelem.
1.1065    raeburn  11132:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11133:            '</form>';
                   11134: }
                   11135: 
                   11136: sub archive_javascript {
1.1056    raeburn  11137:     my ($startcount,$numitems,$titles,$children) = @_;
                   11138:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11139:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11140:     my $scripttag = <<START;
                   11141: <script type="text/javascript">
                   11142: // <![CDATA[
                   11143: 
                   11144: function checkAll(form,prefix) {
                   11145:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11146:     for (var i=0; i < form.elements.length; i++) {
                   11147:         var id = form.elements[i].id;
                   11148:         if ((id != '') && (id != undefined)) {
                   11149:             if (idstr.test(id)) {
                   11150:                 if (form.elements[i].type == 'radio') {
                   11151:                     form.elements[i].checked = true;
1.1056    raeburn  11152:                     var nostart = i-$startcount;
1.1059    raeburn  11153:                     var offset = nostart%7;
                   11154:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11155:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11156:                 }
                   11157:             }
                   11158:         }
                   11159:     }
                   11160: }
                   11161: 
                   11162: function propagateCheck(form,count) {
                   11163:     if (count > 0) {
1.1059    raeburn  11164:         var startelement = $startcount + ((count-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:                         containerCheck(form,count,j);
                   11171:                         break;
                   11172:                     }
1.1055    raeburn  11173:                 }
                   11174:             }
                   11175:         }
                   11176:     }
                   11177: }
                   11178: 
                   11179: numitems = $numitems
1.1056    raeburn  11180: var titles = new Array(numitems);
                   11181: var parents = new Array(numitems);
1.1055    raeburn  11182: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11183:     parents[i] = new Array;
1.1055    raeburn  11184: }
1.1059    raeburn  11185: var maintitle = '$maintitle';
1.1055    raeburn  11186: 
                   11187: START
                   11188: 
1.1056    raeburn  11189:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11190:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11191:         for (my $i=0; $i<@contents; $i ++) {
                   11192:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11193:         }
                   11194:     }
                   11195: 
1.1056    raeburn  11196:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11197:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11198:     }
                   11199: 
1.1055    raeburn  11200:     $scripttag .= <<END;
                   11201: 
                   11202: function containerCheck(form,count,offset) {
                   11203:     if (count > 0) {
1.1056    raeburn  11204:         dependencyCheck(form,count,offset);
1.1059    raeburn  11205:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11206:         form.elements[item].checked = true;
                   11207:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11208:             if (parents[count].length > 0) {
                   11209:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11210:                     containerCheck(form,parents[count][j],offset);
                   11211:                 }
                   11212:             }
                   11213:         }
                   11214:     }
                   11215: }
                   11216: 
                   11217: function dependencyCheck(form,count,offset) {
                   11218:     if (count > 0) {
1.1059    raeburn  11219:         var chosen = (offset+$startcount)+7*(count-1);
                   11220:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11221:         var currtype = form.elements[depitem].type;
                   11222:         if (form.elements[chosen].value == 'dependency') {
                   11223:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11224:             form.elements[depitem].options.length = 0;
                   11225:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11226:             for (var i=1; i<=numitems; i++) {
                   11227:                 if (i == count) {
                   11228:                     continue;
                   11229:                 }
1.1059    raeburn  11230:                 var startelement = $startcount + (i-1) * 7;
                   11231:                 for (var j=1; j<6; j++) {
                   11232:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11233:                         var item = startelement + j;
                   11234:                         if (form.elements[item].type == 'radio') {
                   11235:                             if (form.elements[item].checked) {
                   11236:                                 if (form.elements[item].value == 'display') {
                   11237:                                     var n = form.elements[depitem].options.length;
                   11238:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11239:                                 }
                   11240:                             }
                   11241:                         }
                   11242:                     }
                   11243:                 }
                   11244:             }
                   11245:         } else {
                   11246:             document.getElementById('arc_depon_'+count).style.display='none';
                   11247:             form.elements[depitem].options.length = 0;
                   11248:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11249:         }
1.1059    raeburn  11250:         titleCheck(form,count,offset);
1.1056    raeburn  11251:     }
                   11252: }
                   11253: 
                   11254: function propagateSelect(form,count,offset) {
                   11255:     if (count > 0) {
1.1065    raeburn  11256:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11257:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11258:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11259:             if (parents[count].length > 0) {
                   11260:                 for (var j=0; j<parents[count].length; j++) {
                   11261:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11262:                 }
                   11263:             }
                   11264:         }
                   11265:     }
                   11266: }
1.1056    raeburn  11267: 
                   11268: function containerSelect(form,count,offset,picked) {
                   11269:     if (count > 0) {
1.1065    raeburn  11270:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11271:         if (form.elements[item].type == 'radio') {
                   11272:             if (form.elements[item].value == 'dependency') {
                   11273:                 if (form.elements[item+1].type == 'select-one') {
                   11274:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11275:                         if (form.elements[item+1].options[i].value == picked) {
                   11276:                             form.elements[item+1].selectedIndex = i;
                   11277:                             break;
                   11278:                         }
                   11279:                     }
                   11280:                 }
                   11281:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11282:                     if (parents[count].length > 0) {
                   11283:                         for (var j=0; j<parents[count].length; j++) {
                   11284:                             containerSelect(form,parents[count][j],offset,picked);
                   11285:                         }
                   11286:                     }
                   11287:                 }
                   11288:             }
                   11289:         }
                   11290:     }
                   11291: }
                   11292: 
1.1059    raeburn  11293: function titleCheck(form,count,offset) {
                   11294:     if (count > 0) {
                   11295:         var chosen = (offset+$startcount)+7*(count-1);
                   11296:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11297:         var currtype = form.elements[depitem].type;
                   11298:         if (form.elements[chosen].value == 'display') {
                   11299:             document.getElementById('arc_title_'+count).style.display='block';
                   11300:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11301:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11302:             }
                   11303:         } else {
                   11304:             document.getElementById('arc_title_'+count).style.display='none';
                   11305:             if (currtype == 'text') { 
                   11306:                 document.getElementById('archive_title_'+count).value='';
                   11307:             }
                   11308:         }
                   11309:     }
                   11310:     return;
                   11311: }
                   11312: 
1.1055    raeburn  11313: // ]]>
                   11314: </script>
                   11315: END
                   11316:     return $scripttag;
                   11317: }
                   11318: 
                   11319: sub process_extracted_files {
1.1067    raeburn  11320:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11321:     my $numitems = $env{'form.archive_count'};
                   11322:     return unless ($numitems);
                   11323:     my @ids=&Apache::lonnet::current_machine_ids();
                   11324:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11325:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11326:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11327:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11328:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11329:         $pathtocheck = "$dir_root/$destination";
                   11330:         $dir = $dir_root;
                   11331:         $ishome = 1;
                   11332:     } else {
                   11333:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11334:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11335:         $dir = "$dir_root/$docudom/$docuname";    
                   11336:     }
                   11337:     my $currdir = "$dir_root/$destination";
                   11338:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11339:     if ($env{'form.folderpath'}) {
                   11340:         my @items = split('&',$env{'form.folderpath'});
                   11341:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11342:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11343:             $containers{'0'}='page';
                   11344:         } else {
                   11345:             $containers{'0'}='sequence';
                   11346:         }
1.1055    raeburn  11347:     }
                   11348:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11349:     if ($numitems) {
                   11350:         for (my $i=1; $i<=$numitems; $i++) {
                   11351:             my $path = $env{'form.archive_content_'.$i};
                   11352:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11353:                 my $item = $1;
                   11354:                 $toplevelitems{$item} = $i;
                   11355:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11356:                     $is_dir{$item} = 1;
                   11357:                 }
                   11358:             }
                   11359:         }
                   11360:     }
1.1067    raeburn  11361:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11362:     if (keys(%toplevelitems) > 0) {
                   11363:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11364:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11365:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11366:     }
1.1066    raeburn  11367:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11368:     if ($numitems) {
                   11369:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11370:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11371:             my $path = $env{'form.archive_content_'.$i};
                   11372:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11373:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11374:                     if ($prefix ne '' && $path ne '') {
                   11375:                         if (-e $prefix.$path) {
1.1066    raeburn  11376:                             if ((@archdirs > 0) && 
                   11377:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11378:                                 $todeletedir{$prefix.$path} = 1;
                   11379:                             } else {
                   11380:                                 $todelete{$prefix.$path} = 1;
                   11381:                             }
1.1055    raeburn  11382:                         }
                   11383:                     }
                   11384:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11385:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11386:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11387:                     $docstitle = $env{'form.archive_title_'.$i};
                   11388:                     if ($docstitle eq '') {
                   11389:                         $docstitle = $title;
                   11390:                     }
1.1055    raeburn  11391:                     $outer = 0;
1.1056    raeburn  11392:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11393:                         if (@{$dirorder{$i}} > 0) {
                   11394:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11395:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11396:                                     $outer = $item;
                   11397:                                     last;
                   11398:                                 }
                   11399:                             }
                   11400:                         }
                   11401:                     }
                   11402:                     my ($errtext,$fatal) = 
                   11403:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11404:                                                '/'.$folders{$outer}.'.'.
                   11405:                                                $containers{$outer});
                   11406:                     next if ($fatal);
                   11407:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11408:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11409:                             $mapinner{$i} = time;
1.1055    raeburn  11410:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11411:                             $containers{$i} = 'sequence';
                   11412:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11413:                                       $folders{$i}.'.'.$containers{$i};
                   11414:                             my $newidx = &LONCAPA::map::getresidx();
                   11415:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11416:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11417:                             push(@LONCAPA::map::order,$newidx);
                   11418:                             my ($outtext,$errtext) =
                   11419:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11420:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11421:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11422:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11423:                             unless ($errtext) {
                   11424:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11425:                             }
1.1055    raeburn  11426:                         }
                   11427:                     } else {
                   11428:                         if ($context eq 'coursedocs') {
                   11429:                             my $newidx=&LONCAPA::map::getresidx();
                   11430:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11431:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11432:                                       $title;
                   11433:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11434:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11435:                             }
                   11436:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11437:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11438:                             }
                   11439:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11440:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11441:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11442:                                 unless ($ishome) {
                   11443:                                     my $fetch = "$newdest{$i}/$title";
                   11444:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11445:                                     $prompttofetch{$fetch} = 1;
                   11446:                                 }
1.1055    raeburn  11447:                             }
                   11448:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11449:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11450:                             push(@LONCAPA::map::order, $newidx);
                   11451:                             my ($outtext,$errtext)=
                   11452:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11453:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11454:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11455:                             unless ($errtext) {
                   11456:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11457:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11458:                                 }
                   11459:                             }
1.1055    raeburn  11460:                         }
                   11461:                     }
1.1075.2.11  raeburn  11462:                 }
                   11463:             } else {
                   11464:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   11465:             }
                   11466:         }
                   11467:         for (my $i=1; $i<=$numitems; $i++) {
                   11468:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11469:             my $path = $env{'form.archive_content_'.$i};
                   11470:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11471:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11472:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11473:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11474:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11475:                         my ($itemidx,$fullpath,$relpath);
                   11476:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11477:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11478:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  11479:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11480:                                     $itemidx = $j;
1.1056    raeburn  11481:                                 }
                   11482:                             }
1.1075.2.11  raeburn  11483:                         }
                   11484:                         if ($itemidx eq '') {
                   11485:                             $itemidx =  0;
                   11486:                         }
                   11487:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11488:                             if ($mapinner{$referrer{$i}}) {
                   11489:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11490:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11491:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11492:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11493:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11494:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11495:                                             if (!-e $fullpath) {
                   11496:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11497:                                             }
                   11498:                                         }
1.1075.2.11  raeburn  11499:                                     } else {
                   11500:                                         last;
1.1056    raeburn  11501:                                     }
1.1075.2.11  raeburn  11502:                                 }
                   11503:                             }
                   11504:                         } elsif ($newdest{$referrer{$i}}) {
                   11505:                             $fullpath = $newdest{$referrer{$i}};
                   11506:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11507:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11508:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11509:                                     last;
                   11510:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11511:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11512:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11513:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11514:                                         if (!-e $fullpath) {
                   11515:                                             mkdir($fullpath,0755);
1.1056    raeburn  11516:                                         }
                   11517:                                     }
1.1075.2.11  raeburn  11518:                                 } else {
                   11519:                                     last;
1.1056    raeburn  11520:                                 }
1.1075.2.11  raeburn  11521:                             }
                   11522:                         }
                   11523:                         if ($fullpath ne '') {
                   11524:                             if (-e "$prefix$path") {
                   11525:                                 system("mv $prefix$path $fullpath/$title");
                   11526:                             }
                   11527:                             if (-e "$fullpath/$title") {
                   11528:                                 my $showpath;
                   11529:                                 if ($relpath ne '') {
                   11530:                                     $showpath = "$relpath/$title";
                   11531:                                 } else {
                   11532:                                     $showpath = "/$title";
1.1056    raeburn  11533:                                 }
1.1075.2.11  raeburn  11534:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11535:                             }
                   11536:                             unless ($ishome) {
                   11537:                                 my $fetch = "$fullpath/$title";
                   11538:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   11539:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  11540:                             }
                   11541:                         }
                   11542:                     }
1.1075.2.11  raeburn  11543:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11544:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11545:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11546:                 }
                   11547:             } else {
1.1075.2.11  raeburn  11548:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  11549:             }
                   11550:         }
                   11551:         if (keys(%todelete)) {
                   11552:             foreach my $key (keys(%todelete)) {
                   11553:                 unlink($key);
1.1066    raeburn  11554:             }
                   11555:         }
                   11556:         if (keys(%todeletedir)) {
                   11557:             foreach my $key (keys(%todeletedir)) {
                   11558:                 rmdir($key);
                   11559:             }
                   11560:         }
                   11561:         foreach my $dir (sort(keys(%is_dir))) {
                   11562:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11563:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11564:             }
                   11565:         }
1.1067    raeburn  11566:         if ($result ne '') {
                   11567:             $output .= '<ul>'."\n".
                   11568:                        $result."\n".
                   11569:                        '</ul>';
                   11570:         }
                   11571:         unless ($ishome) {
                   11572:             my $replicationfail;
                   11573:             foreach my $item (keys(%prompttofetch)) {
                   11574:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11575:                 unless ($fetchresult eq 'ok') {
                   11576:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11577:                 }
                   11578:             }
                   11579:             if ($replicationfail) {
                   11580:                 $output .= '<p class="LC_error">'.
                   11581:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   11582:                            $replicationfail.
                   11583:                            '</ul></p>';
                   11584:             }
                   11585:         }
1.1055    raeburn  11586:     } else {
                   11587:         $warning = &mt('No items found in archive.');
                   11588:     }
                   11589:     if ($error) {
                   11590:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11591:                    $error.'</p>'."\n";
                   11592:     }
                   11593:     if ($warning) {
                   11594:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11595:     }
                   11596:     return $output;
                   11597: }
                   11598: 
1.1066    raeburn  11599: sub cleanup_empty_dirs {
                   11600:     my ($path) = @_;
                   11601:     if (($path ne '') && (-d $path)) {
                   11602:         if (opendir(my $dirh,$path)) {
                   11603:             my @dircontents = grep(!/^\./,readdir($dirh));
                   11604:             my $numitems = 0;
                   11605:             foreach my $item (@dircontents) {
                   11606:                 if (-d "$path/$item") {
                   11607:                     &recurse_dirs("$path/$item");
                   11608:                     if (-e "$path/$item") {
                   11609:                         $numitems ++;
                   11610:                     }
                   11611:                 } else {
                   11612:                     $numitems ++;
                   11613:                 }
                   11614:             }
                   11615:             if ($numitems == 0) {
                   11616:                 rmdir($path);
                   11617:             }
                   11618:             closedir($dirh);
                   11619:         }
                   11620:     }
                   11621:     return;
                   11622: }
                   11623: 
1.41      ng       11624: =pod
1.45      matthew  11625: 
1.1068    raeburn  11626: =item &get_folder_hierarchy()
                   11627: 
                   11628: Provides hierarchy of names of folders/sub-folders containing the current
                   11629: item,
                   11630: 
                   11631: Inputs: 3
                   11632:      - $navmap - navmaps object
                   11633: 
                   11634:      - $map - url for map (either the trigger itself, or map containing
                   11635:                            the resource, which is the trigger).
                   11636: 
                   11637:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   11638: 
                   11639: Outputs: 1 @pathitems - array of folder/subfolder names.
                   11640: 
                   11641: =cut
                   11642: 
                   11643: sub get_folder_hierarchy {
                   11644:     my ($navmap,$map,$showitem) = @_;
                   11645:     my @pathitems;
                   11646:     if (ref($navmap)) {
                   11647:         my $mapres = $navmap->getResourceByUrl($map);
                   11648:         if (ref($mapres)) {
                   11649:             my $pcslist = $mapres->map_hierarchy();
                   11650:             if ($pcslist ne '') {
                   11651:                 my @pcs = split(/,/,$pcslist);
                   11652:                 foreach my $pc (@pcs) {
                   11653:                     if ($pc == 1) {
                   11654:                         push(@pathitems,&mt('Main Course Documents'));
                   11655:                     } else {
                   11656:                         my $res = $navmap->getByMapPc($pc);
                   11657:                         if (ref($res)) {
                   11658:                             my $title = $res->compTitle();
                   11659:                             $title =~ s/\W+/_/g;
                   11660:                             if ($title ne '') {
                   11661:                                 push(@pathitems,$title);
                   11662:                             }
                   11663:                         }
                   11664:                     }
                   11665:                 }
                   11666:             }
1.1071    raeburn  11667:             if ($showitem) {
                   11668:                 if ($mapres->{ID} eq '0.0') {
                   11669:                     push(@pathitems,&mt('Main Course Documents'));
                   11670:                 } else {
                   11671:                     my $maptitle = $mapres->compTitle();
                   11672:                     $maptitle =~ s/\W+/_/g;
                   11673:                     if ($maptitle ne '') {
                   11674:                         push(@pathitems,$maptitle);
                   11675:                     }
1.1068    raeburn  11676:                 }
                   11677:             }
                   11678:         }
                   11679:     }
                   11680:     return @pathitems;
                   11681: }
                   11682: 
                   11683: =pod
                   11684: 
1.1015    raeburn  11685: =item * &get_turnedin_filepath()
                   11686: 
                   11687: Determines path in a user's portfolio file for storage of files uploaded
                   11688: to a specific essayresponse or dropbox item.
                   11689: 
                   11690: Inputs: 3 required + 1 optional.
                   11691: $symb is symb for resource, $uname and $udom are for current user (required).
                   11692: $caller is optional (can be "submission", if routine is called when storing
                   11693: an upoaded file when "Submit Answer" button was pressed).
                   11694: 
                   11695: Returns array containing $path and $multiresp. 
                   11696: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   11697: than one file upload item.  Callers of routine should append partid as a 
                   11698: subdirectory to $path in cases where $multiresp is 1.
                   11699: 
                   11700: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   11701: 
                   11702: =cut
                   11703: 
                   11704: sub get_turnedin_filepath {
                   11705:     my ($symb,$uname,$udom,$caller) = @_;
                   11706:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   11707:     my $turnindir;
                   11708:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   11709:     $turnindir = $userhash{'turnindir'};
                   11710:     my ($path,$multiresp);
                   11711:     if ($turnindir eq '') {
                   11712:         if ($caller eq 'submission') {
                   11713:             $turnindir = &mt('turned in');
                   11714:             $turnindir =~ s/\W+/_/g;
                   11715:             my %newhash = (
                   11716:                             'turnindir' => $turnindir,
                   11717:                           );
                   11718:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   11719:         }
                   11720:     }
                   11721:     if ($turnindir ne '') {
                   11722:         $path = '/'.$turnindir.'/';
                   11723:         my ($multipart,$turnin,@pathitems);
                   11724:         my $navmap = Apache::lonnavmaps::navmap->new();
                   11725:         if (defined($navmap)) {
                   11726:             my $mapres = $navmap->getResourceByUrl($map);
                   11727:             if (ref($mapres)) {
                   11728:                 my $pcslist = $mapres->map_hierarchy();
                   11729:                 if ($pcslist ne '') {
                   11730:                     foreach my $pc (split(/,/,$pcslist)) {
                   11731:                         my $res = $navmap->getByMapPc($pc);
                   11732:                         if (ref($res)) {
                   11733:                             my $title = $res->compTitle();
                   11734:                             $title =~ s/\W+/_/g;
                   11735:                             if ($title ne '') {
                   11736:                                 push(@pathitems,$title);
                   11737:                             }
                   11738:                         }
                   11739:                     }
                   11740:                 }
                   11741:                 my $maptitle = $mapres->compTitle();
                   11742:                 $maptitle =~ s/\W+/_/g;
                   11743:                 if ($maptitle ne '') {
                   11744:                     push(@pathitems,$maptitle);
                   11745:                 }
                   11746:                 unless ($env{'request.state'} eq 'construct') {
                   11747:                     my $res = $navmap->getBySymb($symb);
                   11748:                     if (ref($res)) {
                   11749:                         my $partlist = $res->parts();
                   11750:                         my $totaluploads = 0;
                   11751:                         if (ref($partlist) eq 'ARRAY') {
                   11752:                             foreach my $part (@{$partlist}) {
                   11753:                                 my @types = $res->responseType($part);
                   11754:                                 my @ids = $res->responseIds($part);
                   11755:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   11756:                                     if ($types[$i] eq 'essay') {
                   11757:                                         my $partid = $part.'_'.$ids[$i];
                   11758:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   11759:                                             $totaluploads ++;
                   11760:                                         }
                   11761:                                     }
                   11762:                                 }
                   11763:                             }
                   11764:                             if ($totaluploads > 1) {
                   11765:                                 $multiresp = 1;
                   11766:                             }
                   11767:                         }
                   11768:                     }
                   11769:                 }
                   11770:             } else {
                   11771:                 return;
                   11772:             }
                   11773:         } else {
                   11774:             return;
                   11775:         }
                   11776:         my $restitle=&Apache::lonnet::gettitle($symb);
                   11777:         $restitle =~ s/\W+/_/g;
                   11778:         if ($restitle eq '') {
                   11779:             $restitle = ($resurl =~ m{/[^/]+$});
                   11780:             if ($restitle eq '') {
                   11781:                 $restitle = time;
                   11782:             }
                   11783:         }
                   11784:         push(@pathitems,$restitle);
                   11785:         $path .= join('/',@pathitems);
                   11786:     }
                   11787:     return ($path,$multiresp);
                   11788: }
                   11789: 
                   11790: =pod
                   11791: 
1.464     albertel 11792: =back
1.41      ng       11793: 
1.112     bowersj2 11794: =head1 CSV Upload/Handling functions
1.38      albertel 11795: 
1.41      ng       11796: =over 4
                   11797: 
1.648     raeburn  11798: =item * &upfile_store($r)
1.41      ng       11799: 
                   11800: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 11801: needs $env{'form.upfile'}
1.41      ng       11802: returns $datatoken to be put into hidden field
                   11803: 
                   11804: =cut
1.31      albertel 11805: 
                   11806: sub upfile_store {
                   11807:     my $r=shift;
1.258     albertel 11808:     $env{'form.upfile'}=~s/\r/\n/gs;
                   11809:     $env{'form.upfile'}=~s/\f/\n/gs;
                   11810:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   11811:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 11812: 
1.258     albertel 11813:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   11814: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 11815:     {
1.158     raeburn  11816:         my $datafile = $r->dir_config('lonDaemons').
                   11817:                            '/tmp/'.$datatoken.'.tmp';
                   11818:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 11819:             print $fh $env{'form.upfile'};
1.158     raeburn  11820:             close($fh);
                   11821:         }
1.31      albertel 11822:     }
                   11823:     return $datatoken;
                   11824: }
                   11825: 
1.56      matthew  11826: =pod
                   11827: 
1.648     raeburn  11828: =item * &load_tmp_file($r)
1.41      ng       11829: 
                   11830: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 11831: needs $env{'form.datatoken'},
                   11832: sets $env{'form.upfile'} to the contents of the file
1.41      ng       11833: 
                   11834: =cut
1.31      albertel 11835: 
                   11836: sub load_tmp_file {
                   11837:     my $r=shift;
                   11838:     my @studentdata=();
                   11839:     {
1.158     raeburn  11840:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 11841:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  11842:         if ( open(my $fh,"<$studentfile") ) {
                   11843:             @studentdata=<$fh>;
                   11844:             close($fh);
                   11845:         }
1.31      albertel 11846:     }
1.258     albertel 11847:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 11848: }
                   11849: 
1.56      matthew  11850: =pod
                   11851: 
1.648     raeburn  11852: =item * &upfile_record_sep()
1.41      ng       11853: 
                   11854: Separate uploaded file into records
                   11855: returns array of records,
1.258     albertel 11856: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       11857: 
                   11858: =cut
1.31      albertel 11859: 
                   11860: sub upfile_record_sep {
1.258     albertel 11861:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 11862:     } else {
1.248     albertel 11863: 	my @records;
1.258     albertel 11864: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 11865: 	    if ($line=~/^\s*$/) { next; }
                   11866: 	    push(@records,$line);
                   11867: 	}
                   11868: 	return @records;
1.31      albertel 11869:     }
                   11870: }
                   11871: 
1.56      matthew  11872: =pod
                   11873: 
1.648     raeburn  11874: =item * &record_sep($record)
1.41      ng       11875: 
1.258     albertel 11876: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       11877: 
                   11878: =cut
                   11879: 
1.263     www      11880: sub takeleft {
                   11881:     my $index=shift;
                   11882:     return substr('0000'.$index,-4,4);
                   11883: }
                   11884: 
1.31      albertel 11885: sub record_sep {
                   11886:     my $record=shift;
                   11887:     my %components=();
1.258     albertel 11888:     if ($env{'form.upfiletype'} eq 'xml') {
                   11889:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 11890:         my $i=0;
1.356     albertel 11891:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 11892:             $field=~s/^(\"|\')//;
                   11893:             $field=~s/(\"|\')$//;
1.263     www      11894:             $components{&takeleft($i)}=$field;
1.31      albertel 11895:             $i++;
                   11896:         }
1.258     albertel 11897:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 11898:         my $i=0;
1.356     albertel 11899:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 11900:             $field=~s/^(\"|\')//;
                   11901:             $field=~s/(\"|\')$//;
1.263     www      11902:             $components{&takeleft($i)}=$field;
1.31      albertel 11903:             $i++;
                   11904:         }
                   11905:     } else {
1.561     www      11906:         my $separator=',';
1.480     banghart 11907:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      11908:             $separator=';';
1.480     banghart 11909:         }
1.31      albertel 11910:         my $i=0;
1.561     www      11911: # the character we are looking for to indicate the end of a quote or a record 
                   11912:         my $looking_for=$separator;
                   11913: # do not add the characters to the fields
                   11914:         my $ignore=0;
                   11915: # we just encountered a separator (or the beginning of the record)
                   11916:         my $just_found_separator=1;
                   11917: # store the field we are working on here
                   11918:         my $field='';
                   11919: # work our way through all characters in record
                   11920:         foreach my $character ($record=~/(.)/g) {
                   11921:             if ($character eq $looking_for) {
                   11922:                if ($character ne $separator) {
                   11923: # Found the end of a quote, again looking for separator
                   11924:                   $looking_for=$separator;
                   11925:                   $ignore=1;
                   11926:                } else {
                   11927: # Found a separator, store away what we got
                   11928:                   $components{&takeleft($i)}=$field;
                   11929: 	          $i++;
                   11930:                   $just_found_separator=1;
                   11931:                   $ignore=0;
                   11932:                   $field='';
                   11933:                }
                   11934:                next;
                   11935:             }
                   11936: # single or double quotation marks after a separator indicate beginning of a quote
                   11937: # we are now looking for the end of the quote and need to ignore separators
                   11938:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   11939:                $looking_for=$character;
                   11940:                next;
                   11941:             }
                   11942: # ignore would be true after we reached the end of a quote
                   11943:             if ($ignore) { next; }
                   11944:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   11945:             $field.=$character;
                   11946:             $just_found_separator=0; 
1.31      albertel 11947:         }
1.561     www      11948: # catch the very last entry, since we never encountered the separator
                   11949:         $components{&takeleft($i)}=$field;
1.31      albertel 11950:     }
                   11951:     return %components;
                   11952: }
                   11953: 
1.144     matthew  11954: ######################################################
                   11955: ######################################################
                   11956: 
1.56      matthew  11957: =pod
                   11958: 
1.648     raeburn  11959: =item * &upfile_select_html()
1.41      ng       11960: 
1.144     matthew  11961: Return HTML code to select a file from the users machine and specify 
                   11962: the file type.
1.41      ng       11963: 
                   11964: =cut
                   11965: 
1.144     matthew  11966: ######################################################
                   11967: ######################################################
1.31      albertel 11968: sub upfile_select_html {
1.144     matthew  11969:     my %Types = (
                   11970:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 11971:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  11972:                  space => &mt('Space separated'),
                   11973:                  tab   => &mt('Tabulator separated'),
                   11974: #                 xml   => &mt('HTML/XML'),
                   11975:                  );
                   11976:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  11977:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  11978:     foreach my $type (sort(keys(%Types))) {
                   11979:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   11980:     }
                   11981:     $Str .= "</select>\n";
                   11982:     return $Str;
1.31      albertel 11983: }
                   11984: 
1.301     albertel 11985: sub get_samples {
                   11986:     my ($records,$toget) = @_;
                   11987:     my @samples=({});
                   11988:     my $got=0;
                   11989:     foreach my $rec (@$records) {
                   11990: 	my %temp = &record_sep($rec);
                   11991: 	if (! grep(/\S/, values(%temp))) { next; }
                   11992: 	if (%temp) {
                   11993: 	    $samples[$got]=\%temp;
                   11994: 	    $got++;
                   11995: 	    if ($got == $toget) { last; }
                   11996: 	}
                   11997:     }
                   11998:     return \@samples;
                   11999: }
                   12000: 
1.144     matthew  12001: ######################################################
                   12002: ######################################################
                   12003: 
1.56      matthew  12004: =pod
                   12005: 
1.648     raeburn  12006: =item * &csv_print_samples($r,$records)
1.41      ng       12007: 
                   12008: Prints a table of sample values from each column uploaded $r is an
                   12009: Apache Request ref, $records is an arrayref from
                   12010: &Apache::loncommon::upfile_record_sep
                   12011: 
                   12012: =cut
                   12013: 
1.144     matthew  12014: ######################################################
                   12015: ######################################################
1.31      albertel 12016: sub csv_print_samples {
                   12017:     my ($r,$records) = @_;
1.662     bisitz   12018:     my $samples = &get_samples($records,5);
1.301     albertel 12019: 
1.594     raeburn  12020:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12021:               &start_data_table_header_row());
1.356     albertel 12022:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12023:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12024:     $r->print(&end_data_table_header_row());
1.301     albertel 12025:     foreach my $hash (@$samples) {
1.594     raeburn  12026: 	$r->print(&start_data_table_row());
1.356     albertel 12027: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12028: 	    $r->print('<td>');
1.356     albertel 12029: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12030: 	    $r->print('</td>');
                   12031: 	}
1.594     raeburn  12032: 	$r->print(&end_data_table_row());
1.31      albertel 12033:     }
1.594     raeburn  12034:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12035: }
                   12036: 
1.144     matthew  12037: ######################################################
                   12038: ######################################################
                   12039: 
1.56      matthew  12040: =pod
                   12041: 
1.648     raeburn  12042: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12043: 
                   12044: Prints a table to create associations between values and table columns.
1.144     matthew  12045: 
1.41      ng       12046: $r is an Apache Request ref,
                   12047: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12048: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12049: 
                   12050: =cut
                   12051: 
1.144     matthew  12052: ######################################################
                   12053: ######################################################
1.31      albertel 12054: sub csv_print_select_table {
                   12055:     my ($r,$records,$d) = @_;
1.301     albertel 12056:     my $i=0;
                   12057:     my $samples = &get_samples($records,1);
1.144     matthew  12058:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12059: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12060:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12061:               '<th>'.&mt('Column').'</th>'.
                   12062:               &end_data_table_header_row()."\n");
1.356     albertel 12063:     foreach my $array_ref (@$d) {
                   12064: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12065: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12066: 
1.875     bisitz   12067: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12068: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12069: 	$r->print('<option value="none"></option>');
1.356     albertel 12070: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12071: 	    $r->print('<option value="'.$sample.'"'.
                   12072:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12073:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12074: 	}
1.594     raeburn  12075: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12076: 	$i++;
                   12077:     }
1.594     raeburn  12078:     $r->print(&end_data_table());
1.31      albertel 12079:     $i--;
                   12080:     return $i;
                   12081: }
1.56      matthew  12082: 
1.144     matthew  12083: ######################################################
                   12084: ######################################################
                   12085: 
1.56      matthew  12086: =pod
1.31      albertel 12087: 
1.648     raeburn  12088: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12089: 
                   12090: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12091: 
                   12092: $r is an Apache Request ref,
                   12093: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12094: $d is an array of 2 element arrays (internal name, displayed name)
                   12095: 
                   12096: =cut
                   12097: 
1.144     matthew  12098: ######################################################
                   12099: ######################################################
1.31      albertel 12100: sub csv_samples_select_table {
                   12101:     my ($r,$records,$d) = @_;
                   12102:     my $i=0;
1.144     matthew  12103:     #
1.662     bisitz   12104:     my $max_samples = 5;
                   12105:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12106:     $r->print(&start_data_table().
                   12107:               &start_data_table_header_row().'<th>'.
                   12108:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12109:               &end_data_table_header_row());
1.301     albertel 12110: 
                   12111:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12112: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12113: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12114: 	foreach my $option (@$d) {
                   12115: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12116: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12117:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12118:                       $display.'</option>');
1.31      albertel 12119: 	}
                   12120: 	$r->print('</select></td><td>');
1.662     bisitz   12121: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12122: 	    if (defined($samples->[$line]{$key})) { 
                   12123: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12124: 	    }
                   12125: 	}
1.594     raeburn  12126: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12127: 	$i++;
                   12128:     }
1.594     raeburn  12129:     $r->print(&end_data_table());
1.31      albertel 12130:     $i--;
                   12131:     return($i);
1.115     matthew  12132: }
                   12133: 
1.144     matthew  12134: ######################################################
                   12135: ######################################################
                   12136: 
1.115     matthew  12137: =pod
                   12138: 
1.648     raeburn  12139: =item * &clean_excel_name($name)
1.115     matthew  12140: 
                   12141: Returns a replacement for $name which does not contain any illegal characters.
                   12142: 
                   12143: =cut
                   12144: 
1.144     matthew  12145: ######################################################
                   12146: ######################################################
1.115     matthew  12147: sub clean_excel_name {
                   12148:     my ($name) = @_;
                   12149:     $name =~ s/[:\*\?\/\\]//g;
                   12150:     if (length($name) > 31) {
                   12151:         $name = substr($name,0,31);
                   12152:     }
                   12153:     return $name;
1.25      albertel 12154: }
1.84      albertel 12155: 
1.85      albertel 12156: =pod
                   12157: 
1.648     raeburn  12158: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12159: 
                   12160: Returns either 1 or undef
                   12161: 
                   12162: 1 if the part is to be hidden, undef if it is to be shown
                   12163: 
                   12164: Arguments are:
                   12165: 
                   12166: $id the id of the part to be checked
                   12167: $symb, optional the symb of the resource to check
                   12168: $udom, optional the domain of the user to check for
                   12169: $uname, optional the username of the user to check for
                   12170: 
                   12171: =cut
1.84      albertel 12172: 
                   12173: sub check_if_partid_hidden {
                   12174:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12175:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12176: 					 $symb,$udom,$uname);
1.141     albertel 12177:     my $truth=1;
                   12178:     #if the string starts with !, then the list is the list to show not hide
                   12179:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12180:     my @hiddenlist=split(/,/,$hiddenparts);
                   12181:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12182: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12183:     }
1.141     albertel 12184:     return !$truth;
1.84      albertel 12185: }
1.127     matthew  12186: 
1.138     matthew  12187: 
                   12188: ############################################################
                   12189: ############################################################
                   12190: 
                   12191: =pod
                   12192: 
1.157     matthew  12193: =back 
                   12194: 
1.138     matthew  12195: =head1 cgi-bin script and graphing routines
                   12196: 
1.157     matthew  12197: =over 4
                   12198: 
1.648     raeburn  12199: =item * &get_cgi_id()
1.138     matthew  12200: 
                   12201: Inputs: none
                   12202: 
                   12203: Returns an id which can be used to pass environment variables
                   12204: to various cgi-bin scripts.  These environment variables will
                   12205: be removed from the users environment after a given time by
                   12206: the routine &Apache::lonnet::transfer_profile_to_env.
                   12207: 
                   12208: =cut
                   12209: 
                   12210: ############################################################
                   12211: ############################################################
1.152     albertel 12212: my $uniq=0;
1.136     matthew  12213: sub get_cgi_id {
1.154     albertel 12214:     $uniq=($uniq+1)%100000;
1.280     albertel 12215:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12216: }
                   12217: 
1.127     matthew  12218: ############################################################
                   12219: ############################################################
                   12220: 
                   12221: =pod
                   12222: 
1.648     raeburn  12223: =item * &DrawBarGraph()
1.127     matthew  12224: 
1.138     matthew  12225: Facilitates the plotting of data in a (stacked) bar graph.
                   12226: Puts plot definition data into the users environment in order for 
                   12227: graph.png to plot it.  Returns an <img> tag for the plot.
                   12228: The bars on the plot are labeled '1','2',...,'n'.
                   12229: 
                   12230: Inputs:
                   12231: 
                   12232: =over 4
                   12233: 
                   12234: =item $Title: string, the title of the plot
                   12235: 
                   12236: =item $xlabel: string, text describing the X-axis of the plot
                   12237: 
                   12238: =item $ylabel: string, text describing the Y-axis of the plot
                   12239: 
                   12240: =item $Max: scalar, the maximum Y value to use in the plot
                   12241: If $Max is < any data point, the graph will not be rendered.
                   12242: 
1.140     matthew  12243: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12244: they are plotted.  If undefined, default values will be used.
                   12245: 
1.178     matthew  12246: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12247: 
1.138     matthew  12248: =item @Values: An array of array references.  Each array reference holds data
                   12249: to be plotted in a stacked bar chart.
                   12250: 
1.239     matthew  12251: =item If the final element of @Values is a hash reference the key/value
                   12252: pairs will be added to the graph definition.
                   12253: 
1.138     matthew  12254: =back
                   12255: 
                   12256: Returns:
                   12257: 
                   12258: An <img> tag which references graph.png and the appropriate identifying
                   12259: information for the plot.
                   12260: 
1.127     matthew  12261: =cut
                   12262: 
                   12263: ############################################################
                   12264: ############################################################
1.134     matthew  12265: sub DrawBarGraph {
1.178     matthew  12266:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12267:     #
                   12268:     if (! defined($colors)) {
                   12269:         $colors = ['#33ff00', 
                   12270:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12271:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12272:                   ]; 
                   12273:     }
1.228     matthew  12274:     my $extra_settings = {};
                   12275:     if (ref($Values[-1]) eq 'HASH') {
                   12276:         $extra_settings = pop(@Values);
                   12277:     }
1.127     matthew  12278:     #
1.136     matthew  12279:     my $identifier = &get_cgi_id();
                   12280:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12281:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12282:         return '';
                   12283:     }
1.225     matthew  12284:     #
                   12285:     my @Labels;
                   12286:     if (defined($labels)) {
                   12287:         @Labels = @$labels;
                   12288:     } else {
                   12289:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12290:             push (@Labels,$i+1);
                   12291:         }
                   12292:     }
                   12293:     #
1.129     matthew  12294:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12295:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12296:     my %ValuesHash;
                   12297:     my $NumSets=1;
                   12298:     foreach my $array (@Values) {
                   12299:         next if (! ref($array));
1.136     matthew  12300:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12301:             join(',',@$array);
1.129     matthew  12302:     }
1.127     matthew  12303:     #
1.136     matthew  12304:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12305:     if ($NumBars < 3) {
                   12306:         $width = 120+$NumBars*32;
1.220     matthew  12307:         $xskip = 1;
1.225     matthew  12308:         $bar_width = 30;
                   12309:     } elsif ($NumBars < 5) {
                   12310:         $width = 120+$NumBars*20;
                   12311:         $xskip = 1;
                   12312:         $bar_width = 20;
1.220     matthew  12313:     } elsif ($NumBars < 10) {
1.136     matthew  12314:         $width = 120+$NumBars*15;
                   12315:         $xskip = 1;
                   12316:         $bar_width = 15;
                   12317:     } elsif ($NumBars <= 25) {
                   12318:         $width = 120+$NumBars*11;
                   12319:         $xskip = 5;
                   12320:         $bar_width = 8;
                   12321:     } elsif ($NumBars <= 50) {
                   12322:         $width = 120+$NumBars*8;
                   12323:         $xskip = 5;
                   12324:         $bar_width = 4;
                   12325:     } else {
                   12326:         $width = 120+$NumBars*8;
                   12327:         $xskip = 5;
                   12328:         $bar_width = 4;
                   12329:     }
                   12330:     #
1.137     matthew  12331:     $Max = 1 if ($Max < 1);
                   12332:     if ( int($Max) < $Max ) {
                   12333:         $Max++;
                   12334:         $Max = int($Max);
                   12335:     }
1.127     matthew  12336:     $Title  = '' if (! defined($Title));
                   12337:     $xlabel = '' if (! defined($xlabel));
                   12338:     $ylabel = '' if (! defined($ylabel));
1.369     www      12339:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12340:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12341:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12342:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12343:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12344:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12345:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12346:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12347:     $ValuesHash{$id.'.height'}   = $height;
                   12348:     $ValuesHash{$id.'.width'}    = $width;
                   12349:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12350:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12351:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12352:     #
1.228     matthew  12353:     # Deal with other parameters
                   12354:     while (my ($key,$value) = each(%$extra_settings)) {
                   12355:         $ValuesHash{$id.'.'.$key} = $value;
                   12356:     }
                   12357:     #
1.646     raeburn  12358:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12359:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12360: }
                   12361: 
                   12362: ############################################################
                   12363: ############################################################
                   12364: 
                   12365: =pod
                   12366: 
1.648     raeburn  12367: =item * &DrawXYGraph()
1.137     matthew  12368: 
1.138     matthew  12369: Facilitates the plotting of data in an XY graph.
                   12370: Puts plot definition data into the users environment in order for 
                   12371: graph.png to plot it.  Returns an <img> tag for the plot.
                   12372: 
                   12373: Inputs:
                   12374: 
                   12375: =over 4
                   12376: 
                   12377: =item $Title: string, the title of the plot
                   12378: 
                   12379: =item $xlabel: string, text describing the X-axis of the plot
                   12380: 
                   12381: =item $ylabel: string, text describing the Y-axis of the plot
                   12382: 
                   12383: =item $Max: scalar, the maximum Y value to use in the plot
                   12384: If $Max is < any data point, the graph will not be rendered.
                   12385: 
                   12386: =item $colors: Array ref containing the hex color codes for the data to be 
                   12387: plotted in.  If undefined, default values will be used.
                   12388: 
                   12389: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12390: 
                   12391: =item $Ydata: Array ref containing Array refs.  
1.185     www      12392: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12393: 
                   12394: =item %Values: hash indicating or overriding any default values which are 
                   12395: passed to graph.png.  
                   12396: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12397: 
                   12398: =back
                   12399: 
                   12400: Returns:
                   12401: 
                   12402: An <img> tag which references graph.png and the appropriate identifying
                   12403: information for the plot.
                   12404: 
1.137     matthew  12405: =cut
                   12406: 
                   12407: ############################################################
                   12408: ############################################################
                   12409: sub DrawXYGraph {
                   12410:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12411:     #
                   12412:     # Create the identifier for the graph
                   12413:     my $identifier = &get_cgi_id();
                   12414:     my $id = 'cgi.'.$identifier;
                   12415:     #
                   12416:     $Title  = '' if (! defined($Title));
                   12417:     $xlabel = '' if (! defined($xlabel));
                   12418:     $ylabel = '' if (! defined($ylabel));
                   12419:     my %ValuesHash = 
                   12420:         (
1.369     www      12421:          $id.'.title'  => &escape($Title),
                   12422:          $id.'.xlabel' => &escape($xlabel),
                   12423:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12424:          $id.'.y_max_value'=> $Max,
                   12425:          $id.'.labels'     => join(',',@$Xlabels),
                   12426:          $id.'.PlotType'   => 'XY',
                   12427:          );
                   12428:     #
                   12429:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12430:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12431:     }
                   12432:     #
                   12433:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12434:         return '';
                   12435:     }
                   12436:     my $NumSets=1;
1.138     matthew  12437:     foreach my $array (@{$Ydata}){
1.137     matthew  12438:         next if (! ref($array));
                   12439:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12440:     }
1.138     matthew  12441:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12442:     #
                   12443:     # Deal with other parameters
                   12444:     while (my ($key,$value) = each(%Values)) {
                   12445:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12446:     }
                   12447:     #
1.646     raeburn  12448:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12449:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12450: }
                   12451: 
                   12452: ############################################################
                   12453: ############################################################
                   12454: 
                   12455: =pod
                   12456: 
1.648     raeburn  12457: =item * &DrawXYYGraph()
1.138     matthew  12458: 
                   12459: Facilitates the plotting of data in an XY graph with two Y axes.
                   12460: Puts plot definition data into the users environment in order for 
                   12461: graph.png to plot it.  Returns an <img> tag for the plot.
                   12462: 
                   12463: Inputs:
                   12464: 
                   12465: =over 4
                   12466: 
                   12467: =item $Title: string, the title of the plot
                   12468: 
                   12469: =item $xlabel: string, text describing the X-axis of the plot
                   12470: 
                   12471: =item $ylabel: string, text describing the Y-axis of the plot
                   12472: 
                   12473: =item $colors: Array ref containing the hex color codes for the data to be 
                   12474: plotted in.  If undefined, default values will be used.
                   12475: 
                   12476: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12477: 
                   12478: =item $Ydata1: The first data set
                   12479: 
                   12480: =item $Min1: The minimum value of the left Y-axis
                   12481: 
                   12482: =item $Max1: The maximum value of the left Y-axis
                   12483: 
                   12484: =item $Ydata2: The second data set
                   12485: 
                   12486: =item $Min2: The minimum value of the right Y-axis
                   12487: 
                   12488: =item $Max2: The maximum value of the left Y-axis
                   12489: 
                   12490: =item %Values: hash indicating or overriding any default values which are 
                   12491: passed to graph.png.  
                   12492: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12493: 
                   12494: =back
                   12495: 
                   12496: Returns:
                   12497: 
                   12498: An <img> tag which references graph.png and the appropriate identifying
                   12499: information for the plot.
1.136     matthew  12500: 
                   12501: =cut
                   12502: 
                   12503: ############################################################
                   12504: ############################################################
1.137     matthew  12505: sub DrawXYYGraph {
                   12506:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12507:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12508:     #
                   12509:     # Create the identifier for the graph
                   12510:     my $identifier = &get_cgi_id();
                   12511:     my $id = 'cgi.'.$identifier;
                   12512:     #
                   12513:     $Title  = '' if (! defined($Title));
                   12514:     $xlabel = '' if (! defined($xlabel));
                   12515:     $ylabel = '' if (! defined($ylabel));
                   12516:     my %ValuesHash = 
                   12517:         (
1.369     www      12518:          $id.'.title'  => &escape($Title),
                   12519:          $id.'.xlabel' => &escape($xlabel),
                   12520:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12521:          $id.'.labels' => join(',',@$Xlabels),
                   12522:          $id.'.PlotType' => 'XY',
                   12523:          $id.'.NumSets' => 2,
1.137     matthew  12524:          $id.'.two_axes' => 1,
                   12525:          $id.'.y1_max_value' => $Max1,
                   12526:          $id.'.y1_min_value' => $Min1,
                   12527:          $id.'.y2_max_value' => $Max2,
                   12528:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12529:          );
                   12530:     #
1.137     matthew  12531:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12532:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12533:     }
                   12534:     #
                   12535:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12536:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12537:         return '';
                   12538:     }
                   12539:     my $NumSets=1;
1.137     matthew  12540:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12541:         next if (! ref($array));
                   12542:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12543:     }
                   12544:     #
                   12545:     # Deal with other parameters
                   12546:     while (my ($key,$value) = each(%Values)) {
                   12547:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12548:     }
                   12549:     #
1.646     raeburn  12550:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12551:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12552: }
                   12553: 
                   12554: ############################################################
                   12555: ############################################################
                   12556: 
                   12557: =pod
                   12558: 
1.157     matthew  12559: =back 
                   12560: 
1.139     matthew  12561: =head1 Statistics helper routines?  
                   12562: 
                   12563: Bad place for them but what the hell.
                   12564: 
1.157     matthew  12565: =over 4
                   12566: 
1.648     raeburn  12567: =item * &chartlink()
1.139     matthew  12568: 
                   12569: Returns a link to the chart for a specific student.  
                   12570: 
                   12571: Inputs:
                   12572: 
                   12573: =over 4
                   12574: 
                   12575: =item $linktext: The text of the link
                   12576: 
                   12577: =item $sname: The students username
                   12578: 
                   12579: =item $sdomain: The students domain
                   12580: 
                   12581: =back
                   12582: 
1.157     matthew  12583: =back
                   12584: 
1.139     matthew  12585: =cut
                   12586: 
                   12587: ############################################################
                   12588: ############################################################
                   12589: sub chartlink {
                   12590:     my ($linktext, $sname, $sdomain) = @_;
                   12591:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      12592:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 12593:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  12594:        '">'.$linktext.'</a>';
1.153     matthew  12595: }
                   12596: 
                   12597: #######################################################
                   12598: #######################################################
                   12599: 
                   12600: =pod
                   12601: 
                   12602: =head1 Course Environment Routines
1.157     matthew  12603: 
                   12604: =over 4
1.153     matthew  12605: 
1.648     raeburn  12606: =item * &restore_course_settings()
1.153     matthew  12607: 
1.648     raeburn  12608: =item * &store_course_settings()
1.153     matthew  12609: 
                   12610: Restores/Store indicated form parameters from the course environment.
                   12611: Will not overwrite existing values of the form parameters.
                   12612: 
                   12613: Inputs: 
                   12614: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   12615: 
                   12616: a hash ref describing the data to be stored.  For example:
                   12617:    
                   12618: %Save_Parameters = ('Status' => 'scalar',
                   12619:     'chartoutputmode' => 'scalar',
                   12620:     'chartoutputdata' => 'scalar',
                   12621:     'Section' => 'array',
1.373     raeburn  12622:     'Group' => 'array',
1.153     matthew  12623:     'StudentData' => 'array',
                   12624:     'Maps' => 'array');
                   12625: 
                   12626: Returns: both routines return nothing
                   12627: 
1.631     raeburn  12628: =back
                   12629: 
1.153     matthew  12630: =cut
                   12631: 
                   12632: #######################################################
                   12633: #######################################################
                   12634: sub store_course_settings {
1.496     albertel 12635:     return &store_settings($env{'request.course.id'},@_);
                   12636: }
                   12637: 
                   12638: sub store_settings {
1.153     matthew  12639:     # save to the environment
                   12640:     # appenv the same items, just to be safe
1.300     albertel 12641:     my $udom  = $env{'user.domain'};
                   12642:     my $uname = $env{'user.name'};
1.496     albertel 12643:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12644:     my %SaveHash;
                   12645:     my %AppHash;
                   12646:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 12647:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 12648:         my $envname = 'environment.'.$basename;
1.258     albertel 12649:         if (exists($env{'form.'.$setting})) {
1.153     matthew  12650:             # Save this value away
                   12651:             if ($type eq 'scalar' &&
1.258     albertel 12652:                 (! exists($env{$envname}) || 
                   12653:                  $env{$envname} ne $env{'form.'.$setting})) {
                   12654:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   12655:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  12656:             } elsif ($type eq 'array') {
                   12657:                 my $stored_form;
1.258     albertel 12658:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  12659:                     $stored_form = join(',',
                   12660:                                         map {
1.369     www      12661:                                             &escape($_);
1.258     albertel 12662:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  12663:                 } else {
                   12664:                     $stored_form = 
1.369     www      12665:                         &escape($env{'form.'.$setting});
1.153     matthew  12666:                 }
                   12667:                 # Determine if the array contents are the same.
1.258     albertel 12668:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  12669:                     $SaveHash{$basename} = $stored_form;
                   12670:                     $AppHash{$envname}   = $stored_form;
                   12671:                 }
                   12672:             }
                   12673:         }
                   12674:     }
                   12675:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 12676:                                           $udom,$uname);
1.153     matthew  12677:     if ($put_result !~ /^(ok|delayed)/) {
                   12678:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   12679:                                  'got error:'.$put_result);
                   12680:     }
                   12681:     # Make sure these settings stick around in this session, too
1.646     raeburn  12682:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  12683:     return;
                   12684: }
                   12685: 
                   12686: sub restore_course_settings {
1.499     albertel 12687:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 12688: }
                   12689: 
                   12690: sub restore_settings {
                   12691:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12692:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 12693:         next if (exists($env{'form.'.$setting}));
1.496     albertel 12694:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  12695:             '.'.$setting;
1.258     albertel 12696:         if (exists($env{$envname})) {
1.153     matthew  12697:             if ($type eq 'scalar') {
1.258     albertel 12698:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  12699:             } elsif ($type eq 'array') {
1.258     albertel 12700:                 $env{'form.'.$setting} = [ 
1.153     matthew  12701:                                            map { 
1.369     www      12702:                                                &unescape($_); 
1.258     albertel 12703:                                            } split(',',$env{$envname})
1.153     matthew  12704:                                            ];
                   12705:             }
                   12706:         }
                   12707:     }
1.127     matthew  12708: }
                   12709: 
1.618     raeburn  12710: #######################################################
                   12711: #######################################################
                   12712: 
                   12713: =pod
                   12714: 
                   12715: =head1 Domain E-mail Routines  
                   12716: 
                   12717: =over 4
                   12718: 
1.648     raeburn  12719: =item * &build_recipient_list()
1.618     raeburn  12720: 
1.884     raeburn  12721: Build recipient lists for five types of e-mail:
1.766     raeburn  12722: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  12723: (d) Help requests, (e) Course requests needing approval,  generated by
                   12724: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   12725: loncoursequeueadmin.pm respectively.
1.618     raeburn  12726: 
                   12727: Inputs:
1.619     raeburn  12728: defmail (scalar - email address of default recipient), 
1.618     raeburn  12729: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  12730: defdom (domain for which to retrieve configuration settings),
                   12731: origmail (scalar - email address of recipient from loncapa.conf, 
                   12732: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  12733: 
1.655     raeburn  12734: Returns: comma separated list of addresses to which to send e-mail.
                   12735: 
                   12736: =back
1.618     raeburn  12737: 
                   12738: =cut
                   12739: 
                   12740: ############################################################
                   12741: ############################################################
                   12742: sub build_recipient_list {
1.619     raeburn  12743:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  12744:     my @recipients;
                   12745:     my $otheremails;
                   12746:     my %domconfig =
                   12747:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   12748:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  12749:         if (exists($domconfig{'contacts'}{$mailing})) {
                   12750:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   12751:                 my @contacts = ('adminemail','supportemail');
                   12752:                 foreach my $item (@contacts) {
                   12753:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   12754:                         my $addr = $domconfig{'contacts'}{$item}; 
                   12755:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12756:                             push(@recipients,$addr);
                   12757:                         }
1.619     raeburn  12758:                     }
1.766     raeburn  12759:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  12760:                 }
                   12761:             }
1.766     raeburn  12762:         } elsif ($origmail ne '') {
                   12763:             push(@recipients,$origmail);
1.618     raeburn  12764:         }
1.619     raeburn  12765:     } elsif ($origmail ne '') {
                   12766:         push(@recipients,$origmail);
1.618     raeburn  12767:     }
1.688     raeburn  12768:     if (defined($defmail)) {
                   12769:         if ($defmail ne '') {
                   12770:             push(@recipients,$defmail);
                   12771:         }
1.618     raeburn  12772:     }
                   12773:     if ($otheremails) {
1.619     raeburn  12774:         my @others;
                   12775:         if ($otheremails =~ /,/) {
                   12776:             @others = split(/,/,$otheremails);
1.618     raeburn  12777:         } else {
1.619     raeburn  12778:             push(@others,$otheremails);
                   12779:         }
                   12780:         foreach my $addr (@others) {
                   12781:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12782:                 push(@recipients,$addr);
                   12783:             }
1.618     raeburn  12784:         }
                   12785:     }
1.619     raeburn  12786:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  12787:     return $recipientlist;
                   12788: }
                   12789: 
1.127     matthew  12790: ############################################################
                   12791: ############################################################
1.154     albertel 12792: 
1.655     raeburn  12793: =pod
                   12794: 
                   12795: =head1 Course Catalog Routines
                   12796: 
                   12797: =over 4
                   12798: 
                   12799: =item * &gather_categories()
                   12800: 
                   12801: Converts category definitions - keys of categories hash stored in  
                   12802: coursecategories in configuration.db on the primary library server in a 
                   12803: domain - to an array.  Also generates javascript and idx hash used to 
                   12804: generate Domain Coordinator interface for editing Course Categories.
                   12805: 
                   12806: Inputs:
1.663     raeburn  12807: 
1.655     raeburn  12808: categories (reference to hash of category definitions).
1.663     raeburn  12809: 
1.655     raeburn  12810: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12811:       categories and subcategories).
1.663     raeburn  12812: 
1.655     raeburn  12813: idx (reference to hash of counters used in Domain Coordinator interface for 
                   12814:       editing Course Categories).
1.663     raeburn  12815: 
1.655     raeburn  12816: jsarray (reference to array of categories used to create Javascript arrays for
                   12817:          Domain Coordinator interface for editing Course Categories).
                   12818: 
                   12819: Returns: nothing
                   12820: 
                   12821: Side effects: populates cats, idx and jsarray. 
                   12822: 
                   12823: =cut
                   12824: 
                   12825: sub gather_categories {
                   12826:     my ($categories,$cats,$idx,$jsarray) = @_;
                   12827:     my %counters;
                   12828:     my $num = 0;
                   12829:     foreach my $item (keys(%{$categories})) {
                   12830:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   12831:         if ($container eq '' && $depth == 0) {
                   12832:             $cats->[$depth][$categories->{$item}] = $cat;
                   12833:         } else {
                   12834:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   12835:         }
                   12836:         my ($escitem,$tail) = split(/:/,$item,2);
                   12837:         if ($counters{$tail} eq '') {
                   12838:             $counters{$tail} = $num;
                   12839:             $num ++;
                   12840:         }
                   12841:         if (ref($idx) eq 'HASH') {
                   12842:             $idx->{$item} = $counters{$tail};
                   12843:         }
                   12844:         if (ref($jsarray) eq 'ARRAY') {
                   12845:             push(@{$jsarray->[$counters{$tail}]},$item);
                   12846:         }
                   12847:     }
                   12848:     return;
                   12849: }
                   12850: 
                   12851: =pod
                   12852: 
                   12853: =item * &extract_categories()
                   12854: 
                   12855: Used to generate breadcrumb trails for course categories.
                   12856: 
                   12857: Inputs:
1.663     raeburn  12858: 
1.655     raeburn  12859: categories (reference to hash of category definitions).
1.663     raeburn  12860: 
1.655     raeburn  12861: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12862:       categories and subcategories).
1.663     raeburn  12863: 
1.655     raeburn  12864: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  12865: 
1.655     raeburn  12866: allitems (reference to hash - key is category key 
                   12867:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12868: 
1.655     raeburn  12869: idx (reference to hash of counters used in Domain Coordinator interface for
                   12870:       editing Course Categories).
1.663     raeburn  12871: 
1.655     raeburn  12872: jsarray (reference to array of categories used to create Javascript arrays for
                   12873:          Domain Coordinator interface for editing Course Categories).
                   12874: 
1.665     raeburn  12875: subcats (reference to hash of arrays containing all subcategories within each 
                   12876:          category, -recursive)
                   12877: 
1.655     raeburn  12878: Returns: nothing
                   12879: 
                   12880: Side effects: populates trails and allitems hash references.
                   12881: 
                   12882: =cut
                   12883: 
                   12884: sub extract_categories {
1.665     raeburn  12885:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  12886:     if (ref($categories) eq 'HASH') {
                   12887:         &gather_categories($categories,$cats,$idx,$jsarray);
                   12888:         if (ref($cats->[0]) eq 'ARRAY') {
                   12889:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   12890:                 my $name = $cats->[0][$i];
                   12891:                 my $item = &escape($name).'::0';
                   12892:                 my $trailstr;
                   12893:                 if ($name eq 'instcode') {
                   12894:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  12895:                 } elsif ($name eq 'communities') {
                   12896:                     $trailstr = &mt('Communities');
1.655     raeburn  12897:                 } else {
                   12898:                     $trailstr = $name;
                   12899:                 }
                   12900:                 if ($allitems->{$item} eq '') {
                   12901:                     push(@{$trails},$trailstr);
                   12902:                     $allitems->{$item} = scalar(@{$trails})-1;
                   12903:                 }
                   12904:                 my @parents = ($name);
                   12905:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   12906:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   12907:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  12908:                         if (ref($subcats) eq 'HASH') {
                   12909:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   12910:                         }
                   12911:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   12912:                     }
                   12913:                 } else {
                   12914:                     if (ref($subcats) eq 'HASH') {
                   12915:                         $subcats->{$item} = [];
1.655     raeburn  12916:                     }
                   12917:                 }
                   12918:             }
                   12919:         }
                   12920:     }
                   12921:     return;
                   12922: }
                   12923: 
                   12924: =pod
                   12925: 
                   12926: =item *&recurse_categories()
                   12927: 
                   12928: Recursively used to generate breadcrumb trails for course categories.
                   12929: 
                   12930: Inputs:
1.663     raeburn  12931: 
1.655     raeburn  12932: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12933:       categories and subcategories).
1.663     raeburn  12934: 
1.655     raeburn  12935: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  12936: 
                   12937: category (current course category, for which breadcrumb trail is being generated).
                   12938: 
                   12939: trails (reference to array of breadcrumb trails for each category).
                   12940: 
1.655     raeburn  12941: allitems (reference to hash - key is category key
                   12942:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12943: 
1.655     raeburn  12944: parents (array containing containers directories for current category, 
                   12945:          back to top level). 
                   12946: 
                   12947: Returns: nothing
                   12948: 
                   12949: Side effects: populates trails and allitems hash references
                   12950: 
                   12951: =cut
                   12952: 
                   12953: sub recurse_categories {
1.665     raeburn  12954:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  12955:     my $shallower = $depth - 1;
                   12956:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   12957:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   12958:             my $name = $cats->[$depth]{$category}[$k];
                   12959:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12960:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12961:             if ($allitems->{$item} eq '') {
                   12962:                 push(@{$trails},$trailstr);
                   12963:                 $allitems->{$item} = scalar(@{$trails})-1;
                   12964:             }
                   12965:             my $deeper = $depth+1;
                   12966:             push(@{$parents},$category);
1.665     raeburn  12967:             if (ref($subcats) eq 'HASH') {
                   12968:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   12969:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   12970:                     my $higher;
                   12971:                     if ($j > 0) {
                   12972:                         $higher = &escape($parents->[$j]).':'.
                   12973:                                   &escape($parents->[$j-1]).':'.$j;
                   12974:                     } else {
                   12975:                         $higher = &escape($parents->[$j]).'::'.$j;
                   12976:                     }
                   12977:                     push(@{$subcats->{$higher}},$subcat);
                   12978:                 }
                   12979:             }
                   12980:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   12981:                                 $subcats);
1.655     raeburn  12982:             pop(@{$parents});
                   12983:         }
                   12984:     } else {
                   12985:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12986:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12987:         if ($allitems->{$item} eq '') {
                   12988:             push(@{$trails},$trailstr);
                   12989:             $allitems->{$item} = scalar(@{$trails})-1;
                   12990:         }
                   12991:     }
                   12992:     return;
                   12993: }
                   12994: 
1.663     raeburn  12995: =pod
                   12996: 
                   12997: =item *&assign_categories_table()
                   12998: 
                   12999: Create a datatable for display of hierarchical categories in a domain,
                   13000: with checkboxes to allow a course to be categorized. 
                   13001: 
                   13002: Inputs:
                   13003: 
                   13004: cathash - reference to hash of categories defined for the domain (from
                   13005:           configuration.db)
                   13006: 
                   13007: currcat - scalar with an & separated list of categories assigned to a course. 
                   13008: 
1.919     raeburn  13009: type    - scalar contains course type (Course or Community).
                   13010: 
1.663     raeburn  13011: Returns: $output (markup to be displayed) 
                   13012: 
                   13013: =cut
                   13014: 
                   13015: sub assign_categories_table {
1.919     raeburn  13016:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13017:     my $output;
                   13018:     if (ref($cathash) eq 'HASH') {
                   13019:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13020:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13021:         $maxdepth = scalar(@cats);
                   13022:         if (@cats > 0) {
                   13023:             my $itemcount = 0;
                   13024:             if (ref($cats[0]) eq 'ARRAY') {
                   13025:                 my @currcategories;
                   13026:                 if ($currcat ne '') {
                   13027:                     @currcategories = split('&',$currcat);
                   13028:                 }
1.919     raeburn  13029:                 my $table;
1.663     raeburn  13030:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13031:                     my $parent = $cats[0][$i];
1.919     raeburn  13032:                     next if ($parent eq 'instcode');
                   13033:                     if ($type eq 'Community') {
                   13034:                         next unless ($parent eq 'communities');
                   13035:                     } else {
                   13036:                         next if ($parent eq 'communities');
                   13037:                     }
1.663     raeburn  13038:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13039:                     my $item = &escape($parent).'::0';
                   13040:                     my $checked = '';
                   13041:                     if (@currcategories > 0) {
                   13042:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13043:                             $checked = ' checked="checked"';
1.663     raeburn  13044:                         }
                   13045:                     }
1.919     raeburn  13046:                     my $parent_title = $parent;
                   13047:                     if ($parent eq 'communities') {
                   13048:                         $parent_title = &mt('Communities');
                   13049:                     }
                   13050:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13051:                               '<input type="checkbox" name="usecategory" value="'.
                   13052:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13053:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13054:                     my $depth = 1;
                   13055:                     push(@path,$parent);
1.919     raeburn  13056:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13057:                     pop(@path);
1.919     raeburn  13058:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13059:                     $itemcount ++;
                   13060:                 }
1.919     raeburn  13061:                 if ($itemcount) {
                   13062:                     $output = &Apache::loncommon::start_data_table().
                   13063:                               $table.
                   13064:                               &Apache::loncommon::end_data_table();
                   13065:                 }
1.663     raeburn  13066:             }
                   13067:         }
                   13068:     }
                   13069:     return $output;
                   13070: }
                   13071: 
                   13072: =pod
                   13073: 
                   13074: =item *&assign_category_rows()
                   13075: 
                   13076: Create a datatable row for display of nested categories in a domain,
                   13077: with checkboxes to allow a course to be categorized,called recursively.
                   13078: 
                   13079: Inputs:
                   13080: 
                   13081: itemcount - track row number for alternating colors
                   13082: 
                   13083: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13084:       categories and subcategories.
                   13085: 
                   13086: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13087: 
                   13088: parent - parent of current category item
                   13089: 
                   13090: path - Array containing all categories back up through the hierarchy from the
                   13091:        current category to the top level.
                   13092: 
                   13093: currcategories - reference to array of current categories assigned to the course
                   13094: 
                   13095: Returns: $output (markup to be displayed).
                   13096: 
                   13097: =cut
                   13098: 
                   13099: sub assign_category_rows {
                   13100:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13101:     my ($text,$name,$item,$chgstr);
                   13102:     if (ref($cats) eq 'ARRAY') {
                   13103:         my $maxdepth = scalar(@{$cats});
                   13104:         if (ref($cats->[$depth]) eq 'HASH') {
                   13105:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13106:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13107:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13108:                 $text .= '<td><table class="LC_datatable">';
                   13109:                 for (my $j=0; $j<$numchildren; $j++) {
                   13110:                     $name = $cats->[$depth]{$parent}[$j];
                   13111:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13112:                     my $deeper = $depth+1;
                   13113:                     my $checked = '';
                   13114:                     if (ref($currcategories) eq 'ARRAY') {
                   13115:                         if (@{$currcategories} > 0) {
                   13116:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13117:                                 $checked = ' checked="checked"';
1.663     raeburn  13118:                             }
                   13119:                         }
                   13120:                     }
1.664     raeburn  13121:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13122:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13123:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13124:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13125:                              '</td><td>';
1.663     raeburn  13126:                     if (ref($path) eq 'ARRAY') {
                   13127:                         push(@{$path},$name);
                   13128:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13129:                         pop(@{$path});
                   13130:                     }
                   13131:                     $text .= '</td></tr>';
                   13132:                 }
                   13133:                 $text .= '</table></td>';
                   13134:             }
                   13135:         }
                   13136:     }
                   13137:     return $text;
                   13138: }
                   13139: 
1.655     raeburn  13140: ############################################################
                   13141: ############################################################
                   13142: 
                   13143: 
1.443     albertel 13144: sub commit_customrole {
1.664     raeburn  13145:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13146:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13147:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13148:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13149:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13150:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13151:                  '</b><br />';
                   13152:     return $output;
                   13153: }
                   13154: 
                   13155: sub commit_standardrole {
1.541     raeburn  13156:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   13157:     my ($output,$logmsg,$linefeed);
                   13158:     if ($context eq 'auto') {
                   13159:         $linefeed = "\n";
                   13160:     } else {
                   13161:         $linefeed = "<br />\n";
                   13162:     }  
1.443     albertel 13163:     if ($three eq 'st') {
1.541     raeburn  13164:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   13165:                                          $one,$two,$sec,$context);
                   13166:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13167:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13168:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13169:         } else {
1.541     raeburn  13170:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13171:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13172:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13173:             if ($context eq 'auto') {
                   13174:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13175:             } else {
                   13176:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13177:                &mt('Add to classlist').': <b>ok</b>';
                   13178:             }
                   13179:             $output .= $linefeed;
1.443     albertel 13180:         }
                   13181:     } else {
                   13182:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13183:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13184:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13185:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13186:         if ($context eq 'auto') {
                   13187:             $output .= $result.$linefeed;
                   13188:         } else {
                   13189:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13190:         }
1.443     albertel 13191:     }
                   13192:     return $output;
                   13193: }
                   13194: 
                   13195: sub commit_studentrole {
1.541     raeburn  13196:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  13197:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13198:     if ($context eq 'auto') {
                   13199:         $linefeed = "\n";
                   13200:     } else {
                   13201:         $linefeed = '<br />'."\n";
                   13202:     }
1.443     albertel 13203:     if (defined($one) && defined($two)) {
                   13204:         my $cid=$one.'_'.$two;
                   13205:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13206:         my $secchange = 0;
                   13207:         my $expire_role_result;
                   13208:         my $modify_section_result;
1.628     raeburn  13209:         if ($oldsec ne '-1') { 
                   13210:             if ($oldsec ne $sec) {
1.443     albertel 13211:                 $secchange = 1;
1.628     raeburn  13212:                 my $now = time;
1.443     albertel 13213:                 my $uurl='/'.$cid;
                   13214:                 $uurl=~s/\_/\//g;
                   13215:                 if ($oldsec) {
                   13216:                     $uurl.='/'.$oldsec;
                   13217:                 }
1.626     raeburn  13218:                 $oldsecurl = $uurl;
1.628     raeburn  13219:                 $expire_role_result = 
1.652     raeburn  13220:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13221:                 if ($env{'request.course.sec'} ne '') { 
                   13222:                     if ($expire_role_result eq 'refused') {
                   13223:                         my @roles = ('st');
                   13224:                         my @statuses = ('previous');
                   13225:                         my @roledoms = ($one);
                   13226:                         my $withsec = 1;
                   13227:                         my %roleshash = 
                   13228:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13229:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13230:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13231:                             my ($oldstart,$oldend) = 
                   13232:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13233:                             if ($oldend > 0 && $oldend <= $now) {
                   13234:                                 $expire_role_result = 'ok';
                   13235:                             }
                   13236:                         }
                   13237:                     }
                   13238:                 }
1.443     albertel 13239:                 $result = $expire_role_result;
                   13240:             }
                   13241:         }
                   13242:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  13243:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 13244:             if ($modify_section_result =~ /^ok/) {
                   13245:                 if ($secchange == 1) {
1.628     raeburn  13246:                     if ($sec eq '') {
                   13247:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13248:                     } else {
                   13249:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13250:                     }
1.443     albertel 13251:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13252:                     if ($sec eq '') {
                   13253:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13254:                     } else {
                   13255:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13256:                     }
1.443     albertel 13257:                 } else {
1.628     raeburn  13258:                     if ($sec eq '') {
                   13259:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13260:                     } else {
                   13261:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13262:                     }
1.443     albertel 13263:                 }
                   13264:             } else {
1.628     raeburn  13265:                 if ($secchange) {       
                   13266:                     $$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;
                   13267:                 } else {
                   13268:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13269:                 }
1.443     albertel 13270:             }
                   13271:             $result = $modify_section_result;
                   13272:         } elsif ($secchange == 1) {
1.628     raeburn  13273:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13274:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
1.628     raeburn  13275:             } else {
                   13276:                 $$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;
                   13277:             }
1.626     raeburn  13278:             if ($expire_role_result eq 'refused') {
                   13279:                 my $newsecurl = '/'.$cid;
                   13280:                 $newsecurl =~ s/\_/\//g;
                   13281:                 if ($sec ne '') {
                   13282:                     $newsecurl.='/'.$sec;
                   13283:                 }
                   13284:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13285:                     if ($sec eq '') {
                   13286:                         $$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;
                   13287:                     } else {
                   13288:                         $$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;
                   13289:                     }
                   13290:                 }
                   13291:             }
1.443     albertel 13292:         }
                   13293:     } else {
1.626     raeburn  13294:         $$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 13295:         $result = "error: incomplete course id\n";
                   13296:     }
                   13297:     return $result;
                   13298: }
                   13299: 
1.1075.2.25! raeburn  13300: sub show_role_extent {
        !          13301:     my ($scope,$context,$role) = @_;
        !          13302:     $scope =~ s{^/}{};
        !          13303:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
        !          13304:     push(@courseroles,'co');
        !          13305:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
        !          13306:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
        !          13307:         $scope =~ s{/}{_};
        !          13308:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
        !          13309:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
        !          13310:         my ($audom,$auname) = split(/\//,$scope);
        !          13311:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
        !          13312:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
        !          13313:     } else {
        !          13314:         $scope =~ s{/$}{};
        !          13315:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
        !          13316:                    &Apache::lonnet::domain($scope,'description').'</span>');
        !          13317:     }
        !          13318: }
        !          13319: 
1.443     albertel 13320: ############################################################
                   13321: ############################################################
                   13322: 
1.566     albertel 13323: sub check_clone {
1.578     raeburn  13324:     my ($args,$linefeed) = @_;
1.566     albertel 13325:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13326:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13327:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13328:     my $clonemsg;
                   13329:     my $can_clone = 0;
1.944     raeburn  13330:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13331:     if ($lctype ne 'community') {
                   13332:         $lctype = 'course';
                   13333:     }
1.566     albertel 13334:     if ($clonehome eq 'no_host') {
1.944     raeburn  13335:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13336:             $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'});
                   13337:         } else {
                   13338:             $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'});
                   13339:         }     
1.566     albertel 13340:     } else {
                   13341: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13342:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13343:             if ($clonedesc{'type'} ne 'Community') {
                   13344:                  $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'});
                   13345:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13346:             }
                   13347:         }
1.882     raeburn  13348: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13349:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13350: 	    $can_clone = 1;
                   13351: 	} else {
                   13352: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13353: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13354: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13355:             if (grep(/^\*$/,@cloners)) {
                   13356:                 $can_clone = 1;
                   13357:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13358:                 $can_clone = 1;
                   13359:             } else {
1.908     raeburn  13360:                 my $ccrole = 'cc';
1.944     raeburn  13361:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13362:                     $ccrole = 'co';
                   13363:                 }
1.578     raeburn  13364: 	        my %roleshash =
                   13365: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13366: 					 $args->{'ccdomain'},
1.908     raeburn  13367:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13368: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13369: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13370:                     $can_clone = 1;
                   13371:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13372:                     $can_clone = 1;
                   13373:                 } else {
1.944     raeburn  13374:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13375:                         $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'});
                   13376:                     } else {
                   13377:                         $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'});
                   13378:                     }
1.578     raeburn  13379: 	        }
1.566     albertel 13380: 	    }
1.578     raeburn  13381:         }
1.566     albertel 13382:     }
                   13383:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13384: }
                   13385: 
1.444     albertel 13386: sub construct_course {
1.885     raeburn  13387:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13388:     my $outcome;
1.541     raeburn  13389:     my $linefeed =  '<br />'."\n";
                   13390:     if ($context eq 'auto') {
                   13391:         $linefeed = "\n";
                   13392:     }
1.566     albertel 13393: 
                   13394: #
                   13395: # Are we cloning?
                   13396: #
                   13397:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13398:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13399: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13400: 	if ($context ne 'auto') {
1.578     raeburn  13401:             if ($clonemsg ne '') {
                   13402: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13403:             }
1.566     albertel 13404: 	}
                   13405: 	$outcome .= $clonemsg.$linefeed;
                   13406: 
                   13407:         if (!$can_clone) {
                   13408: 	    return (0,$outcome);
                   13409: 	}
                   13410:     }
                   13411: 
1.444     albertel 13412: #
                   13413: # Open course
                   13414: #
                   13415:     my $crstype = lc($args->{'crstype'});
                   13416:     my %cenv=();
                   13417:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13418:                                              $args->{'cdescr'},
                   13419:                                              $args->{'curl'},
                   13420:                                              $args->{'course_home'},
                   13421:                                              $args->{'nonstandard'},
                   13422:                                              $args->{'crscode'},
                   13423:                                              $args->{'ccuname'}.':'.
                   13424:                                              $args->{'ccdomain'},
1.882     raeburn  13425:                                              $args->{'crstype'},
1.885     raeburn  13426:                                              $cnum,$context,$category);
1.444     albertel 13427: 
                   13428:     # Note: The testing routines depend on this being output; see 
                   13429:     # Utils::Course. This needs to at least be output as a comment
                   13430:     # if anyone ever decides to not show this, and Utils::Course::new
                   13431:     # will need to be suitably modified.
1.541     raeburn  13432:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13433:     if ($$courseid =~ /^error:/) {
                   13434:         return (0,$outcome);
                   13435:     }
                   13436: 
1.444     albertel 13437: #
                   13438: # Check if created correctly
                   13439: #
1.479     albertel 13440:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13441:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13442:     if ($crsuhome eq 'no_host') {
                   13443:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13444:         return (0,$outcome);
                   13445:     }
1.541     raeburn  13446:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13447: 
1.444     albertel 13448: #
1.566     albertel 13449: # Do the cloning
                   13450: #   
                   13451:     if ($can_clone && $cloneid) {
                   13452: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13453: 	if ($context ne 'auto') {
                   13454: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13455: 	}
                   13456: 	$outcome .= $clonemsg.$linefeed;
                   13457: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13458: # Copy all files
1.637     www      13459: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13460: # Restore URL
1.566     albertel 13461: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13462: # Restore title
1.566     albertel 13463: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13464: # Restore creation date, creator and creation context.
                   13465:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13466:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13467:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13468: # Mark as cloned
1.566     albertel 13469: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13470: # Need to clone grading mode
                   13471:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13472:         $cenv{'grading'}=$newenv{'grading'};
                   13473: # Do not clone these environment entries
                   13474:         &Apache::lonnet::del('environment',
                   13475:                   ['default_enrollment_start_date',
                   13476:                    'default_enrollment_end_date',
                   13477:                    'question.email',
                   13478:                    'policy.email',
                   13479:                    'comment.email',
                   13480:                    'pch.users.denied',
1.725     raeburn  13481:                    'plc.users.denied',
                   13482:                    'hidefromcat',
                   13483:                    'categories'],
1.638     www      13484:                    $$crsudom,$$crsunum);
1.444     albertel 13485:     }
1.566     albertel 13486: 
1.444     albertel 13487: #
                   13488: # Set environment (will override cloned, if existing)
                   13489: #
                   13490:     my @sections = ();
                   13491:     my @xlists = ();
                   13492:     if ($args->{'crstype'}) {
                   13493:         $cenv{'type'}=$args->{'crstype'};
                   13494:     }
                   13495:     if ($args->{'crsid'}) {
                   13496:         $cenv{'courseid'}=$args->{'crsid'};
                   13497:     }
                   13498:     if ($args->{'crscode'}) {
                   13499:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13500:     }
                   13501:     if ($args->{'crsquota'} ne '') {
                   13502:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13503:     } else {
                   13504:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13505:     }
                   13506:     if ($args->{'ccuname'}) {
                   13507:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13508:                                         ':'.$args->{'ccdomain'};
                   13509:     } else {
                   13510:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13511:     }
                   13512:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13513:     if ($args->{'crssections'}) {
                   13514:         $cenv{'internal.sectionnums'} = '';
                   13515:         if ($args->{'crssections'} =~ m/,/) {
                   13516:             @sections = split/,/,$args->{'crssections'};
                   13517:         } else {
                   13518:             $sections[0] = $args->{'crssections'};
                   13519:         }
                   13520:         if (@sections > 0) {
                   13521:             foreach my $item (@sections) {
                   13522:                 my ($sec,$gp) = split/:/,$item;
                   13523:                 my $class = $args->{'crscode'}.$sec;
                   13524:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13525:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13526:                 unless ($addcheck eq 'ok') {
                   13527:                     push @badclasses, $class;
                   13528:                 }
                   13529:             }
                   13530:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13531:         }
                   13532:     }
                   13533: # do not hide course coordinator from staff listing, 
                   13534: # even if privileged
                   13535:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13536: # add crosslistings
                   13537:     if ($args->{'crsxlist'}) {
                   13538:         $cenv{'internal.crosslistings'}='';
                   13539:         if ($args->{'crsxlist'} =~ m/,/) {
                   13540:             @xlists = split/,/,$args->{'crsxlist'};
                   13541:         } else {
                   13542:             $xlists[0] = $args->{'crsxlist'};
                   13543:         }
                   13544:         if (@xlists > 0) {
                   13545:             foreach my $item (@xlists) {
                   13546:                 my ($xl,$gp) = split/:/,$item;
                   13547:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13548:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13549:                 unless ($addcheck eq 'ok') {
                   13550:                     push @badclasses, $xl;
                   13551:                 }
                   13552:             }
                   13553:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13554:         }
                   13555:     }
                   13556:     if ($args->{'autoadds'}) {
                   13557:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13558:     }
                   13559:     if ($args->{'autodrops'}) {
                   13560:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13561:     }
                   13562: # check for notification of enrollment changes
                   13563:     my @notified = ();
                   13564:     if ($args->{'notify_owner'}) {
                   13565:         if ($args->{'ccuname'} ne '') {
                   13566:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   13567:         }
                   13568:     }
                   13569:     if ($args->{'notify_dc'}) {
                   13570:         if ($uname ne '') { 
1.630     raeburn  13571:             push(@notified,$uname.':'.$udom);
1.444     albertel 13572:         }
                   13573:     }
                   13574:     if (@notified > 0) {
                   13575:         my $notifylist;
                   13576:         if (@notified > 1) {
                   13577:             $notifylist = join(',',@notified);
                   13578:         } else {
                   13579:             $notifylist = $notified[0];
                   13580:         }
                   13581:         $cenv{'internal.notifylist'} = $notifylist;
                   13582:     }
                   13583:     if (@badclasses > 0) {
                   13584:         my %lt=&Apache::lonlocal::texthash(
                   13585:                 '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',
                   13586:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   13587:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   13588:         );
1.541     raeburn  13589:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   13590:                            ' ('.$lt{'adby'}.')';
                   13591:         if ($context eq 'auto') {
                   13592:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 13593:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  13594:             foreach my $item (@badclasses) {
                   13595:                 if ($context eq 'auto') {
                   13596:                     $outcome .= " - $item\n";
                   13597:                 } else {
                   13598:                     $outcome .= "<li>$item</li>\n";
                   13599:                 }
                   13600:             }
                   13601:             if ($context eq 'auto') {
                   13602:                 $outcome .= $linefeed;
                   13603:             } else {
1.566     albertel 13604:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  13605:             }
                   13606:         } 
1.444     albertel 13607:     }
                   13608:     if ($args->{'no_end_date'}) {
                   13609:         $args->{'endaccess'} = 0;
                   13610:     }
                   13611:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   13612:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   13613:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   13614:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   13615:     if ($args->{'showphotos'}) {
                   13616:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   13617:     }
                   13618:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   13619:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   13620:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   13621:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  13622:             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'); 
                   13623:             if ($context eq 'auto') {
                   13624:                 $outcome .= $krb_msg;
                   13625:             } else {
1.566     albertel 13626:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  13627:             }
                   13628:             $outcome .= $linefeed;
1.444     albertel 13629:         }
                   13630:     }
                   13631:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   13632:        if ($args->{'setpolicy'}) {
                   13633:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13634:        }
                   13635:        if ($args->{'setcontent'}) {
                   13636:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13637:        }
                   13638:     }
                   13639:     if ($args->{'reshome'}) {
                   13640: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   13641: 	$cenv{'reshome'}=~s/\/+$/\//;
                   13642:     }
                   13643: #
                   13644: # course has keyed access
                   13645: #
                   13646:     if ($args->{'setkeys'}) {
                   13647:        $cenv{'keyaccess'}='yes';
                   13648:     }
                   13649: # if specified, key authority is not course, but user
                   13650: # only active if keyaccess is yes
                   13651:     if ($args->{'keyauth'}) {
1.487     albertel 13652: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   13653: 	$user = &LONCAPA::clean_username($user);
                   13654: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     13655: 	if ($user ne '' && $domain ne '') {
1.487     albertel 13656: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 13657: 	}
                   13658:     }
                   13659: 
                   13660:     if ($args->{'disresdis'}) {
                   13661:         $cenv{'pch.roles.denied'}='st';
                   13662:     }
                   13663:     if ($args->{'disablechat'}) {
                   13664:         $cenv{'plc.roles.denied'}='st';
                   13665:     }
                   13666: 
                   13667:     # Record we've not yet viewed the Course Initialization Helper for this 
                   13668:     # course
                   13669:     $cenv{'course.helper.not.run'} = 1;
                   13670:     #
                   13671:     # Use new Randomseed
                   13672:     #
                   13673:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   13674:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   13675:     #
                   13676:     # The encryption code and receipt prefix for this course
                   13677:     #
                   13678:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   13679:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   13680:     #
                   13681:     # By default, use standard grading
                   13682:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   13683: 
1.541     raeburn  13684:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   13685:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13686: #
                   13687: # Open all assignments
                   13688: #
                   13689:     if ($args->{'openall'}) {
                   13690:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   13691:        my %storecontent = ($storeunder         => time,
                   13692:                            $storeunder.'.type' => 'date_start');
                   13693:        
                   13694:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  13695:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13696:    }
                   13697: #
                   13698: # Set first page
                   13699: #
                   13700:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   13701: 	    || ($cloneid)) {
1.445     albertel 13702: 	use LONCAPA::map;
1.444     albertel 13703: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 13704: 
                   13705: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   13706:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   13707: 
1.444     albertel 13708:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   13709:         my $title; my $url;
                   13710:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   13711: 	    $title=&mt('Syllabus');
1.444     albertel 13712:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   13713:         } else {
1.963     raeburn  13714:             $title=&mt('Table of Contents');
1.444     albertel 13715:             $url='/adm/navmaps';
                   13716:         }
1.445     albertel 13717: 
                   13718:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   13719: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   13720: 
                   13721: 	if ($errtext) { $fatal=2; }
1.541     raeburn  13722:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 13723:     }
1.566     albertel 13724: 
                   13725:     return (1,$outcome);
1.444     albertel 13726: }
                   13727: 
                   13728: ############################################################
                   13729: ############################################################
                   13730: 
1.953     droeschl 13731: #SD
                   13732: # only Community and Course, or anything else?
1.378     raeburn  13733: sub course_type {
                   13734:     my ($cid) = @_;
                   13735:     if (!defined($cid)) {
                   13736:         $cid = $env{'request.course.id'};
                   13737:     }
1.404     albertel 13738:     if (defined($env{'course.'.$cid.'.type'})) {
                   13739:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  13740:     } else {
                   13741:         return 'Course';
1.377     raeburn  13742:     }
                   13743: }
1.156     albertel 13744: 
1.406     raeburn  13745: sub group_term {
                   13746:     my $crstype = &course_type();
                   13747:     my %names = (
                   13748:                   'Course' => 'group',
1.865     raeburn  13749:                   'Community' => 'group',
1.406     raeburn  13750:                 );
                   13751:     return $names{$crstype};
                   13752: }
                   13753: 
1.902     raeburn  13754: sub course_types {
                   13755:     my @types = ('official','unofficial','community');
                   13756:     my %typename = (
                   13757:                          official   => 'Official course',
                   13758:                          unofficial => 'Unofficial course',
                   13759:                          community  => 'Community',
                   13760:                    );
                   13761:     return (\@types,\%typename);
                   13762: }
                   13763: 
1.156     albertel 13764: sub icon {
                   13765:     my ($file)=@_;
1.505     albertel 13766:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 13767:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 13768:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 13769:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   13770: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   13771: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13772: 	            $curfext.".gif") {
                   13773: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13774: 		$curfext.".gif";
                   13775: 	}
                   13776:     }
1.249     albertel 13777:     return &lonhttpdurl($iconname);
1.154     albertel 13778: } 
1.84      albertel 13779: 
1.575     albertel 13780: sub lonhttpdurl {
1.692     www      13781: #
                   13782: # Had been used for "small fry" static images on separate port 8080.
                   13783: # Modify here if lightweight http functionality desired again.
                   13784: # Currently eliminated due to increasing firewall issues.
                   13785: #
1.575     albertel 13786:     my ($url)=@_;
1.692     www      13787:     return $url;
1.215     albertel 13788: }
                   13789: 
1.213     albertel 13790: sub connection_aborted {
                   13791:     my ($r)=@_;
                   13792:     $r->print(" ");$r->rflush();
                   13793:     my $c = $r->connection;
                   13794:     return $c->aborted();
                   13795: }
                   13796: 
1.221     foxr     13797: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     13798: #    strings as 'strings'.
                   13799: sub escape_single {
1.221     foxr     13800:     my ($input) = @_;
1.223     albertel 13801:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     13802:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   13803:     return $input;
                   13804: }
1.223     albertel 13805: 
1.222     foxr     13806: #  Same as escape_single, but escape's "'s  This 
                   13807: #  can be used for  "strings"
                   13808: sub escape_double {
                   13809:     my ($input) = @_;
                   13810:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   13811:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   13812:     return $input;
                   13813: }
1.223     albertel 13814:  
1.222     foxr     13815: #   Escapes the last element of a full URL.
                   13816: sub escape_url {
                   13817:     my ($url)   = @_;
1.238     raeburn  13818:     my @urlslices = split(/\//, $url,-1);
1.369     www      13819:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 13820:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     13821: }
1.462     albertel 13822: 
1.820     raeburn  13823: sub compare_arrays {
                   13824:     my ($arrayref1,$arrayref2) = @_;
                   13825:     my (@difference,%count);
                   13826:     @difference = ();
                   13827:     %count = ();
                   13828:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   13829:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   13830:         foreach my $element (keys(%count)) {
                   13831:             if ($count{$element} == 1) {
                   13832:                 push(@difference,$element);
                   13833:             }
                   13834:         }
                   13835:     }
                   13836:     return @difference;
                   13837: }
                   13838: 
1.817     bisitz   13839: # -------------------------------------------------------- Initialize user login
1.462     albertel 13840: sub init_user_environment {
1.463     albertel 13841:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 13842:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   13843: 
                   13844:     my $public=($username eq 'public' && $domain eq 'public');
                   13845: 
                   13846: # See if old ID present, if so, remove
                   13847: 
1.1062    raeburn  13848:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 13849:     my $now=time;
                   13850: 
                   13851:     if ($public) {
                   13852: 	my $max_public=100;
                   13853: 	my $oldest;
                   13854: 	my $oldest_time=0;
                   13855: 	for(my $next=1;$next<=$max_public;$next++) {
                   13856: 	    if (-e $lonids."/publicuser_$next.id") {
                   13857: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   13858: 		if ($mtime<$oldest_time || !$oldest_time) {
                   13859: 		    $oldest_time=$mtime;
                   13860: 		    $oldest=$next;
                   13861: 		}
                   13862: 	    } else {
                   13863: 		$cookie="publicuser_$next";
                   13864: 		last;
                   13865: 	    }
                   13866: 	}
                   13867: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   13868:     } else {
1.463     albertel 13869: 	# if this isn't a robot, kill any existing non-robot sessions
                   13870: 	if (!$args->{'robot'}) {
                   13871: 	    opendir(DIR,$lonids);
                   13872: 	    while ($filename=readdir(DIR)) {
                   13873: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   13874: 		    unlink($lonids.'/'.$filename);
                   13875: 		}
1.462     albertel 13876: 	    }
1.463     albertel 13877: 	    closedir(DIR);
1.462     albertel 13878: 	}
                   13879: # Give them a new cookie
1.463     albertel 13880: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      13881: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 13882: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 13883:     
                   13884: # Initialize roles
                   13885: 
1.1062    raeburn  13886: 	($userroles,$firstaccenv,$timerintenv) = 
                   13887:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 13888:     }
                   13889: # ------------------------------------ Check browser type and MathML capability
                   13890: 
                   13891:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   13892:         $clientunicode,$clientos) = &decode_user_agent($r);
                   13893: 
                   13894: # ------------------------------------------------------------- Get environment
                   13895: 
                   13896:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   13897:     my ($tmp) = keys(%userenv);
                   13898:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   13899:     } else {
                   13900: 	undef(%userenv);
                   13901:     }
                   13902:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   13903: 	$form->{'interface'}=$userenv{'interface'};
                   13904:     }
                   13905:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   13906: 
                   13907: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   13908:     foreach my $option ('interface','localpath','localres') {
                   13909:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 13910:     }
                   13911: # --------------------------------------------------------- Write first profile
                   13912: 
                   13913:     {
                   13914: 	my %initial_env = 
                   13915: 	    ("user.name"          => $username,
                   13916: 	     "user.domain"        => $domain,
                   13917: 	     "user.home"          => $authhost,
                   13918: 	     "browser.type"       => $clientbrowser,
                   13919: 	     "browser.version"    => $clientversion,
                   13920: 	     "browser.mathml"     => $clientmathml,
                   13921: 	     "browser.unicode"    => $clientunicode,
                   13922: 	     "browser.os"         => $clientos,
                   13923: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   13924: 	     "request.course.fn"  => '',
                   13925: 	     "request.course.uri" => '',
                   13926: 	     "request.course.sec" => '',
                   13927: 	     "request.role"       => 'cm',
                   13928: 	     "request.role.adv"   => $env{'user.adv'},
                   13929: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   13930: 
                   13931:         if ($form->{'localpath'}) {
                   13932: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   13933: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   13934:         }
                   13935: 	
                   13936: 	if ($form->{'interface'}) {
                   13937: 	    $form->{'interface'}=~s/\W//gs;
                   13938: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   13939: 	    $env{'browser.interface'}=$form->{'interface'};
                   13940: 	}
                   13941: 
1.981     raeburn  13942:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  13943:         my %domdef;
                   13944:         unless ($domain eq 'public') {
                   13945:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   13946:         }
1.980     raeburn  13947: 
1.1075.2.7  raeburn  13948:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  13949:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  13950:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   13951:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  13952:         }
                   13953: 
1.864     raeburn  13954:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  13955:             $userenv{'canrequest.'.$crstype} =
                   13956:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  13957:                                                   'reload','requestcourses',
                   13958:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  13959:         }
                   13960: 
1.1075.2.14  raeburn  13961:         $userenv{'canrequest.author'} =
                   13962:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   13963:                                         'reload','requestauthor',
                   13964:                                         \%userenv,\%domdef,\%is_adv);
                   13965:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   13966:                                              $domain,$username);
                   13967:         my $reqstatus = $reqauthor{'author_status'};
                   13968:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   13969:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   13970:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   13971:                                                   $reqauthor{'author'}{'timestamp'};
                   13972:             }
                   13973:         }
                   13974: 
1.462     albertel 13975: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  13976: 
1.462     albertel 13977: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   13978: 		 &GDBM_WRCREAT(),0640)) {
                   13979: 	    &_add_to_env(\%disk_env,\%initial_env);
                   13980: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   13981: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  13982:             if (ref($firstaccenv) eq 'HASH') {
                   13983:                 &_add_to_env(\%disk_env,$firstaccenv);
                   13984:             }
                   13985:             if (ref($timerintenv) eq 'HASH') {
                   13986:                 &_add_to_env(\%disk_env,$timerintenv);
                   13987:             }
1.463     albertel 13988: 	    if (ref($args->{'extra_env'})) {
                   13989: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   13990: 	    }
1.462     albertel 13991: 	    untie(%disk_env);
                   13992: 	} else {
1.705     tempelho 13993: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   13994: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 13995: 	    return 'error: '.$!;
                   13996: 	}
                   13997:     }
                   13998:     $env{'request.role'}='cm';
                   13999:     $env{'request.role.adv'}=$env{'user.adv'};
                   14000:     $env{'browser.type'}=$clientbrowser;
                   14001: 
                   14002:     return $cookie;
                   14003: 
                   14004: }
                   14005: 
                   14006: sub _add_to_env {
                   14007:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14008:     if (ref($env_data) eq 'HASH') {
                   14009:         while (my ($key,$value) = each(%$env_data)) {
                   14010: 	    $idf->{$prefix.$key} = $value;
                   14011: 	    $env{$prefix.$key}   = $value;
                   14012:         }
1.462     albertel 14013:     }
                   14014: }
                   14015: 
1.685     tempelho 14016: # --- Get the symbolic name of a problem and the url
                   14017: sub get_symb {
                   14018:     my ($request,$silent) = @_;
1.726     raeburn  14019:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14020:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14021:     if ($symb eq '') {
                   14022:         if (!$silent) {
1.1071    raeburn  14023:             if (ref($request)) { 
                   14024:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14025:             }
1.685     tempelho 14026:             return ();
                   14027:         }
                   14028:     }
                   14029:     &Apache::lonenc::check_decrypt(\$symb);
                   14030:     return ($symb);
                   14031: }
                   14032: 
                   14033: # --------------------------------------------------------------Get annotation
                   14034: 
                   14035: sub get_annotation {
                   14036:     my ($symb,$enc) = @_;
                   14037: 
                   14038:     my $key = $symb;
                   14039:     if (!$enc) {
                   14040:         $key =
                   14041:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14042:     }
                   14043:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14044:     return $annotation{$key};
                   14045: }
                   14046: 
                   14047: sub clean_symb {
1.731     raeburn  14048:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14049: 
                   14050:     &Apache::lonenc::check_decrypt(\$symb);
                   14051:     my $enc = $env{'request.enc'};
1.731     raeburn  14052:     if ($delete_enc) {
1.730     raeburn  14053:         delete($env{'request.enc'});
                   14054:     }
1.685     tempelho 14055: 
                   14056:     return ($symb,$enc);
                   14057: }
1.462     albertel 14058: 
1.990     raeburn  14059: sub build_release_hashes {
                   14060:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14061:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14062:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14063:                   (ref($randomizetry) eq 'HASH'));
                   14064:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14065:         my ($item,$name,$value) = split(/:/,$key);
                   14066:         if ($item eq 'parameter') {
                   14067:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14068:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14069:                     push(@{$checkparms->{$name}},$value);
                   14070:                 }
                   14071:             } else {
                   14072:                 push(@{$checkparms->{$name}},$value);
                   14073:             }
                   14074:         } elsif ($item eq 'resourcetag') {
                   14075:             if ($name eq 'responsetype') {
                   14076:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14077:             }
                   14078:         } elsif ($item eq 'course') {
                   14079:             if ($name eq 'crstype') {
                   14080:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14081:             }
                   14082:         }
                   14083:     }
                   14084:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14085:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14086:     return;
                   14087: }
                   14088: 
1.1075.2.11  raeburn  14089: sub update_content_constraints {
                   14090:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14091:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14092:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14093:     my %checkresponsetypes;
                   14094:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14095:         my ($item,$name,$value) = split(/:/,$key);
                   14096:         if ($item eq 'resourcetag') {
                   14097:             if ($name eq 'responsetype') {
                   14098:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14099:             }
                   14100:         }
                   14101:     }
                   14102:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14103:     if (defined($navmap)) {
                   14104:         my %allresponses;
                   14105:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14106:             my %responses = $res->responseTypes();
                   14107:             foreach my $key (keys(%responses)) {
                   14108:                 next unless(exists($checkresponsetypes{$key}));
                   14109:                 $allresponses{$key} += $responses{$key};
                   14110:             }
                   14111:         }
                   14112:         foreach my $key (keys(%allresponses)) {
                   14113:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14114:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14115:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14116:             }
                   14117:         }
                   14118:         undef($navmap);
                   14119:     }
                   14120:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14121:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14122:     }
                   14123:     return;
                   14124: }
                   14125: 
                   14126: sub parse_supplemental_title {
                   14127:     my ($title) = @_;
                   14128: 
                   14129:     my ($foldertitle,$renametitle);
                   14130:     if ($title =~ /&amp;&amp;&amp;/) {
                   14131:         $title = &HTML::Entites::decode($title);
                   14132:     }
                   14133:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14134:         $renametitle=$4;
                   14135:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14136:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14137:         my $name =  &plainname($uname,$udom);
                   14138:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14139:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14140:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14141:             $name.': <br />'.$foldertitle;
                   14142:     }
                   14143:     if (wantarray) {
                   14144:         return ($title,$foldertitle,$renametitle);
                   14145:     }
                   14146:     return $title;
                   14147: }
                   14148: 
1.1075.2.18  raeburn  14149: sub symb_to_docspath {
                   14150:     my ($symb) = @_;
                   14151:     return unless ($symb);
                   14152:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   14153:     if ($resurl=~/\.(sequence|page)$/) {
                   14154:         $mapurl=$resurl;
                   14155:     } elsif ($resurl eq 'adm/navmaps') {
                   14156:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   14157:     }
                   14158:     my $mapresobj;
                   14159:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14160:     if (ref($navmap)) {
                   14161:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   14162:     }
                   14163:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   14164:     my $type=$2;
                   14165:     my $path;
                   14166:     if (ref($mapresobj)) {
                   14167:         my $pcslist = $mapresobj->map_hierarchy();
                   14168:         if ($pcslist ne '') {
                   14169:             foreach my $pc (split(/,/,$pcslist)) {
                   14170:                 next if ($pc <= 1);
                   14171:                 my $res = $navmap->getByMapPc($pc);
                   14172:                 if (ref($res)) {
                   14173:                     my $thisurl = $res->src();
                   14174:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   14175:                     my $thistitle = $res->title();
                   14176:                     $path .= '&'.
                   14177:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
                   14178:                              &Apache::lonhtmlcommon::entity_encode($thistitle).
                   14179:                              ':'.$res->randompick().
                   14180:                              ':'.$res->randomout().
                   14181:                              ':'.$res->encrypted().
                   14182:                              ':'.$res->randomorder().
                   14183:                              ':'.$res->is_page();
                   14184:                 }
                   14185:             }
                   14186:         }
                   14187:         $path =~ s/^\&//;
                   14188:         my $maptitle = $mapresobj->title();
                   14189:         if ($mapurl eq 'default') {
                   14190:             $maptitle = 'Main Course Documents';
                   14191:         }
                   14192:         $path .= (($path ne '')? '&' : '').
                   14193:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14194:                  &Apache::lonhtmlcommon::entity_encode($maptitle).
                   14195:                  ':'.$mapresobj->randompick().
                   14196:                  ':'.$mapresobj->randomout().
                   14197:                  ':'.$mapresobj->encrypted().
                   14198:                  ':'.$mapresobj->randomorder().
                   14199:                  ':'.$mapresobj->is_page();
                   14200:     } else {
                   14201:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   14202:         my $ispage = (($type eq 'page')? 1 : '');
                   14203:         if ($mapurl eq 'default') {
                   14204:             $maptitle = 'Main Course Documents';
                   14205:         }
                   14206:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14207:                 &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
                   14208:     }
                   14209:     unless ($mapurl eq 'default') {
                   14210:         $path = 'default&'.
                   14211:                 &Apache::lonhtmlcommon::entity_encode('Main Course Documents').
                   14212:                 ':::::&'.$path;
                   14213:     }
                   14214:     return $path;
                   14215: }
                   14216: 
1.1075.2.14  raeburn  14217: sub captcha_display {
                   14218:     my ($context,$lonhost) = @_;
                   14219:     my ($output,$error);
                   14220:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14221:     if ($captcha eq 'original') {
                   14222:         $output = &create_captcha();
                   14223:         unless ($output) {
                   14224:             $error = 'captcha';
                   14225:         }
                   14226:     } elsif ($captcha eq 'recaptcha') {
                   14227:         $output = &create_recaptcha($pubkey);
                   14228:         unless ($output) {
                   14229:             $error = 'recaptcha';
                   14230:         }
                   14231:     }
                   14232:     return ($output,$error);
                   14233: }
                   14234: 
                   14235: sub captcha_response {
                   14236:     my ($context,$lonhost) = @_;
                   14237:     my ($captcha_chk,$captcha_error);
                   14238:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14239:     if ($captcha eq 'original') {
                   14240:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14241:     } elsif ($captcha eq 'recaptcha') {
                   14242:         $captcha_chk = &check_recaptcha($privkey);
                   14243:     } else {
                   14244:         $captcha_chk = 1;
                   14245:     }
                   14246:     return ($captcha_chk,$captcha_error);
                   14247: }
                   14248: 
                   14249: sub get_captcha_config {
                   14250:     my ($context,$lonhost) = @_;
                   14251:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   14252:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14253:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14254:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   14255:     if ($context eq 'usercreation') {
                   14256:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14257:         if (ref($domconfig{$context}) eq 'HASH') {
                   14258:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14259:             if (ref($hashtocheck) eq 'HASH') {
                   14260:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14261:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14262:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14263:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14264:                     }
                   14265:                     if ($privkey && $pubkey) {
                   14266:                         $captcha = 'recaptcha';
                   14267:                     } else {
                   14268:                         $captcha = 'original';
                   14269:                     }
                   14270:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14271:                     $captcha = 'original';
                   14272:                 }
                   14273:             }
                   14274:         } else {
                   14275:             $captcha = 'captcha';
                   14276:         }
                   14277:     } elsif ($context eq 'login') {
                   14278:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14279:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14280:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14281:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   14282:             if ($privkey && $pubkey) {
                   14283:                 $captcha = 'recaptcha';
                   14284:             } else {
                   14285:                 $captcha = 'original';
                   14286:             }
                   14287:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14288:             $captcha = 'original';
                   14289:         }
                   14290:     }
                   14291:     return ($captcha,$pubkey,$privkey);
                   14292: }
                   14293: 
                   14294: sub create_captcha {
                   14295:     my %captcha_params = &captcha_settings();
                   14296:     my ($output,$maxtries,$tries) = ('',10,0);
                   14297:     while ($tries < $maxtries) {
                   14298:         $tries ++;
                   14299:         my $captcha = Authen::Captcha->new (
                   14300:                                            output_folder => $captcha_params{'output_dir'},
                   14301:                                            data_folder   => $captcha_params{'db_dir'},
                   14302:                                           );
                   14303:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14304: 
                   14305:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14306:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14307:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14308:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14309:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14310:             last;
                   14311:         }
                   14312:     }
                   14313:     return $output;
                   14314: }
                   14315: 
                   14316: sub captcha_settings {
                   14317:     my %captcha_params = (
                   14318:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14319:                            www_output_dir => "/captchaspool",
                   14320:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14321:                            numchars       => '5',
                   14322:                          );
                   14323:     return %captcha_params;
                   14324: }
                   14325: 
                   14326: sub check_captcha {
                   14327:     my ($captcha_chk,$captcha_error);
                   14328:     my $code = $env{'form.code'};
                   14329:     my $md5sum = $env{'form.crypt'};
                   14330:     my %captcha_params = &captcha_settings();
                   14331:     my $captcha = Authen::Captcha->new(
                   14332:                       output_folder => $captcha_params{'output_dir'},
                   14333:                       data_folder   => $captcha_params{'db_dir'},
                   14334:                   );
                   14335:     my $captcha_chk = $captcha->check_code($code,$md5sum);
                   14336:     my %captcha_hash = (
                   14337:                         0       => 'Code not checked (file error)',
                   14338:                        -1      => 'Failed: code expired',
                   14339:                        -2      => 'Failed: invalid code (not in database)',
                   14340:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14341:     );
                   14342:     if ($captcha_chk != 1) {
                   14343:         $captcha_error = $captcha_hash{$captcha_chk}
                   14344:     }
                   14345:     return ($captcha_chk,$captcha_error);
                   14346: }
                   14347: 
                   14348: sub create_recaptcha {
                   14349:     my ($pubkey) = @_;
                   14350:     my $captcha = Captcha::reCAPTCHA->new;
                   14351:     return $captcha->get_options_setter({theme => 'white'})."\n".
                   14352:            $captcha->get_html($pubkey).
                   14353:            &mt('If either word is hard to read, [_1] will replace them.',
                   14354:                '<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   14355:            '<br /><br />';
                   14356: }
                   14357: 
                   14358: sub check_recaptcha {
                   14359:     my ($privkey) = @_;
                   14360:     my $captcha_chk;
                   14361:     my $captcha = Captcha::reCAPTCHA->new;
                   14362:     my $captcha_result =
                   14363:         $captcha->check_answer(
                   14364:                                 $privkey,
                   14365:                                 $ENV{'REMOTE_ADDR'},
                   14366:                                 $env{'form.recaptcha_challenge_field'},
                   14367:                                 $env{'form.recaptcha_response_field'},
                   14368:                               );
                   14369:     if ($captcha_result->{is_valid}) {
                   14370:         $captcha_chk = 1;
                   14371:     }
                   14372:     return $captcha_chk;
                   14373: }
                   14374: 
1.41      ng       14375: =pod
                   14376: 
                   14377: =back
                   14378: 
1.112     bowersj2 14379: =cut
1.41      ng       14380: 
1.112     bowersj2 14381: 1;
                   14382: __END__;
1.41      ng       14383: 

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